I. Notions▲
BGRABitmap est un ensemble d'unités Pascal permettant de modifier et de créer des images avec transparence. L'accès direct aux pixels permet de faire des traitements rapides sur les images.
Les pixels d'une image avec transparence sont stockés avec quatre valeurs, ici des octets, dans l'ordre Bleu, Vert, Rouge, Alpha. Le dernier canal définit le niveau d'opacité (0 signifie transparent, 255 signifie opaque), et les autres canaux définissent la couleur.
On peut distinguer deux modes de dessins. Le premier consiste à remplacer les valeurs du pixel, ce qui est le cas avec le Canvas standard. Dans BGRABitmap, il s'agit du mode dmSet. Le deuxième consiste à effectuer un mélange entre le pixel déjà présent et celui qu'on dessine, ce qui appelé alpha blending.
I-A. Correction gamma▲
Lors du mélange de pixels, on peut tenir compte ou non de la non-linéarité de l'intensité lumineuse en fonction de la valeur associée à une composante. Si un pixel contient autant de rouge que de vert et de bleu, il est gris ou blanc. Chaque composante a alors la même valeur n comprise entre 0 et 255. Quand n varie, l'intensité lumineuse varie. Mais pour les petites valeurs de n, l'intensité varie peu, tandis que pour les grandes valeurs de n, l'intensité varie beaucoup. Pour être plus précis, l'intensité lumineuse varie environ comme la valeur n avec un certain exposant, qu'on appelle gamma.
Or, quand on mélange deux pixels, si on fait la moyenne des composantes, on obtient un résultat dont l'intensité lumineuse n'est pas à mi-chemin des deux couleurs d'origine. La correction gamma permet de faire le mélange de façon à ce que l'intensité résultante soit effectivement à mi-chemin.
Dans BGRABitmap, le mélange linéaire, sans correction gamma, est spécifié avec le mode dmLinearBlend tandis que le mélange avec correction gamma est spécifié avec dmDrawWithTransparency. Bien que le résultat attendu est généralement celui avec correction gamma, il peut être utile d'utiliser un mélange linéaire pour des raisons de rapidité ou bien parce que l'on travaille avec des masques.
II. Installation▲
Pour installer BGRABitmap, vous avez deux possibilités : l'installer comme un package ou bien l'ajouter comme référence au projet en cours.
Les fichiers sont téléchargeables sur le site de LazPaint sur SourceForge à l'adresse suivante :
http://sourceforge.net/projects/lazpaint/files/src/
II-A. Installer comme un package▲
Pour installer le package, ouvrez le fichier bgrabitmappack.lpk et cliquez sur Installer (dans le sous-menu avec l'icône d'éclair dans les nouvelles versions). Lazarus demande si on veut vraiment l'installer parce qu'il n'y a pas de composants puis s'il faut reconstruire Lazarus. Répondez oui aux deux questions.
Ensuite, créez un nouveau projet avec le menu Projet > Nouveau projet et allez dans le menu Projet > Inspecteur de projet. Cliquez sur Ajouter (le « + »), allez dans l'onglet Nouvelle condition, choisissez le paquet « bgrabitmappack » et cliquez sur OK.
II-B. Ajouter simplement comme une référence▲
Vous pouvez simplement ajouter le répertoire où se situe BGRABitmap dans le chemin de recherche des unités pour le projet (-Fu). Pour cela, créez un nouveau projet avec le menu Projet > Nouveau projet puis allez dans les options du compilateur avec le menu Projet > Options du compilateur. Dans « autres fichiers unité », ajoutez le chemin relatif à BGRABitmap. Par exemple, si BGRABitmap est dans un dossier à côté de votre projet, le chemin relatif pourrait être « ..\BGRABitmap ».
Si vous copiez les fichiers de BGRABitmap dans le même dossier que le projet, vous n'avez pas besoin d'ajouter un tel chemin de recherche. Cependant, cela n'est pas recommandé, parce que si vous avez plusieurs projets utilisant la bibliothèque, cela devient une tâche répétitive de mettre à jour une nouvelle version de la bibliothèque.
Si vous êtes perdus avec les chemins relatifs, vous pouvez aussi ajouter ce chemin en ajoutant l'unité BGRABitmap à votre projet. Pour faire cela, ouvrez à l'intérieur de votre projet le fichier bgrabitmap.pas. Après, utilisez le menu Projet > Ajouter le fichier au projet. Lazarus demandera si vous voulez ajouter le fichier et le nouveau répertoire au projet.
III. Premier projet▲
Créez une application fenêtrée avec le menu Projet > Nouveau projet et ajouter la référence à BGRABitmap comme expliqué en (2).
L'unité de la fenêtre principale devrait ressembler à cela :
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs;
type
{ TForm1 }
TForm1 = class(TForm)
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
initialization
{$I UMain.lrs}
end.Si vous ne la trouvez pas, utilisez Ctrl-F12 pour afficher la liste des fichiers.
Sauvegarder votre projet à côté de la librairie BGRABitamp avec le menu Ficher > Tout enregistrer (pas forcément dans le même répertoire).
III-A. Premier dessin▲
Ajoutez un événement de dessin. Pour cela, cliquez une fois sur la fenêtre, ensuite allez dans l'inspecteur d'objet, dans l'onglet Événements, et double-cliquez sur la ligne OnPaint. Lazarus ajoutera automatiquement un gestionnaire FormPaint à l'unité de la fenêtre principale. Ajoutez par exemple le code suivant à l'intérieur :
procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBGRABitmap;
begin
bmp := TBGRABitmap.Create(ClientWidth, ClientHeight, BGRABlack);
//remplit un rectangle orange
bmp.FillRect(20, 20, 100, 40, BGRA(255,192,0), dmSet);
//affiche la BGRABitmap sur la fenêtre
bmp.Draw(Canvas, 0, 0, True);
//libère la mémoire
bmp.Free;
end;Comme vous pouvez le voir, vous avez besoin de définir une variable TBGRABitmap et de la créer. Il y a plusieurs constructeurs différents. Celui utilisé ici crée une image de taille ClientWidth x ClientHeight et remplit avec du noir. ClientWidth et ClientHeight sont des propriétés de la fenêtre qui renvoient la place disponible pour dessiner à l'intérieur de la fenêtre.
La procédure FillRect prend les paramètres usuels pour dessiner un rectangle, c'est-à -dire le coin haut-gauche suivi par le coin bas-droite plus 1. Cela veut dire que le pixel à (100,40) est exclu du rectangle.
Après cela, il y a le paramètre de couleur avec les composantes rouge/vert/bleu, et le mode de dessin. dmSet signifie de simplement remplacer les pixels.
N'oubliez pas de libérer l'objet après utilisation pour éviter les fuites de mémoire.
III-B. Résultat▲
Vous devriez obtenir le code suivant :
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
BGRABitmap, BGRABitmapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormPaint(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormPaint(Sender: TObject);
var bmp: TBGRABitmap;
begin
bmp := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRABlack);
bmp.FillRect(20,20,100,40,BGRA(255,192,0),dmSet);
bmp.Draw(Canvas,0,0,True);
bmp.Free;
end;
initialization
{$I UMain.lrs}
end.Et à l'exécution, vous devriez obtenir une fenêtre remplie de noir avec un rectangle orange dedans.
IV. Charger une image▲
Ce chapitre montre comment charger une image et l'afficher.
Commencez un nouveau projet, sauvegardez-le et copiez une image dans le répertoire du projet. Supposons que son nom est image.png.
Ajoutez une variable privée à la fenêtre principale pour stocker l'image :
TForm1 = class(TForm)
private
{ private declarations }
image: TBGRABitmap;
public
{ public declarations }
end;Programmez le chargement de l'image quand la fenêtre est créée. Pour faire cela, double-cliquez sur la fenêtre. Une procédure devrait apparaitre dans l'éditeur de code. Ajoutez-y l'instruction de chargement :
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create('image.png');
end;Ajoutez aussi un gestionnaire OnDestroy pour libérer l'objet à la fermeture de la fenêtre :
procedure TForm1.FormDestroy(Sender: TObject);
begin
image.free;
end;IV-A. Afficher l'image▲
Ajouter un gestionnaire OnPaint. Pour cela, cliquez sur la fenêtre, allez dans l'inspecteur d'objet, dans l'onglet événement et double-cliquez sur la ligne OnPaint. Ensuite, ajoutez le code suivant :
procedure TForm1.FormPaint(Sender: TObject);
begin
image.Draw(Canvas,0,0,True);
end;Remarquez que le dernier paramètre est à vrai, ce qui signifie opaque. Si vous voulez prendre en compte les pixels transparents, encodés dans le canal alpha, vous devez mettre False à la place. Mais cela peut être lent de dessiner avec transparence sur un Canvas standard, alors si ce n'est pas nécessaire, préparez une image opaque et utilisez le dessin opaque seulement.
À l'exécution, vous devriez voir une fenêtre avec une image dessinée dedans au coin supérieur gauche.
IV-B. Centrer l'image▲
Vous pouvez centrer l'image sur la fenêtre. Pour cela, modifiez la procédure FormPaint :
procedure TForm1.FormPaint(Sender: TObject);
var ImagePos: TPoint;
begin
ImagePos := Point( (ClientWidth - Image.Width) div 2,
(ClientHeight - Image.Height) div 2 );
// test si la position est négative
if ImagePos.X < 0 then ImagePos.X := 0;
if ImagePos.Y < 0 then ImagePos.Y := 0;
image.Draw(Canvas,ImagePos.X,ImagePos.Y,True);
end;Pour calculer la position, nous avons besoin de déterminer l'espace entre l'image et le bord gauche (coordonnée X) et l'espace entre l'image et le bord haut (coordonnée Y). L'expression ClientWidth - Image.Width renvoie l'espace horizontal disponible, et on divise par 2 pour obtenir la marge gauche.
Le résultat peut être négatif si l'image est plus grande que la largeur cliente. Dans ce cas, la marge est mise à zéro.
Vous pouvez lancer le programme et voir si cela marche. Notez ce qu'il se passe si vous enlevez le test pour la position négative.
IV-C. Étirer une image▲
Pour étirer une image, nous avons besoin de créer une image temporaire étirée :
procedure TForm1.FormPaint(Sender: TObject);
var stretched: TBGRABitmap;
begin
stretched := image.Resample(ClientWidth,ClientHeight) as TBGRABitmap;
stretched.Draw(Canvas,0,0,True);
stretched.Free;
end;Par défaut, Resample utilise un joli rééchantillonnage, mais vous pouvez préciser si vous voulez un rééchantillonnage simple à la place (plus rapide) :
stretched := image.Resample(ClientWidth,ClientHeight,rmSimpleStretch)
as TBGRABitmap;Vous pouvez choisir le filtre de rééchantillonage en utilisant la propriété ResampleFilter :
image.ResampleFilter := rfMitchell;
stretched := image.Resample(ClientWidth,ClientHeight) as TBGRABitmap;Les filtres Mitchell et Spline sont plus lents que les autres parce qu'ils utilisent davantage de pixels pour calculer l'interpolation (16 pixels lors d'un agrandissement). Le filtre rfBestQuality prend Mitchell pour la réduction d'image et Spline pour l'agrandissement.
V. Dessiner avec la souris▲
Ce chapitre montre comment dessiner avec la souris.
Commencez un nouveau projet et ajoutez une variable privée à la fenêtre principale pour stocker l'image :
TForm1 = class(TForm)
private
{ private declarations }
image: TBGRABitmap;
public
{ public declarations }
end;Créez l'image quand la fenêtre est créée. Pour faire cela, double-cliquez sur la fenêtre. Une procédure devrait apparaitre dans l'éditeur de code. Ajoutez l'instruction de création :
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create(640,480,BGRAWhite);
end;L'image est ainsi créée avec une taille de 640 par 480 et un fond blanc.
Appelez la fonction Free dans un gestionnaire OnDestroy pour libérer l'image au moment de la fermeture de la fenêtre.
V-A. Dessin de l'image▲
L'image a besoin d'être redessinée lorsque la fenêtre est affichée ou redimensionnée. Il faut donc un gestionnaire OnPaint. Pour cela, cliquez sur la fenêtre, allez dans l'inspecteur d'objet, dans l'onglet événement et double-cliquez sur la ligne OnPaint. Ensuite, ajoutez le code suivant :
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;Ajoutez la procédure PaintImage :
procedure TForm1.PaintImage;
begin
image.Draw(Canvas,0,0,True);
end;Après avoir écrit cela, mettez le curseur texte sur PaintImage et pressez Ctrl-Shift-C pour ajouter la déclaration de la procédure à l'interface.
V-B. Gestion de la souris▲
Avec l'inspecteur d'objet, ajouter des gestionnaires pour les événements MouseDown et MouseMove :
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then DrawBrush(X,Y);
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if ssLeft in Shift then DrawBrush(X,Y);
end;Ajoutez la procédure DrawBrush :
procedure TForm1.DrawBrush(X, Y: Integer);
const radius = 5;
begin
image.GradientFill(X-radius,Y-radius, X+radius,Y+radius,
BGRABlack,BGRAPixelTransparent, gtRadial,
PointF(X,Y), PointF(X+radius,Y), dmDrawWithTransparency);
PaintImage;
end;Après avoir écrit cela, mettez le curseur texte sur DrawBrush et pressez Ctrl-Shift-C pour ajouter la déclaration à l'interface.
Cette procédure dessine un gradient radial (gtRadial) :
- le rectangle encadrant est (X-radius,Y-radius, X+radius,Y+radius);
- le centre est noir, le bord est transparent;
- le centre est à (X,Y) et le bord du cercle à (X+radius,Y).
V-C. Exécution du programme▲
|
Vous pouvez dessiner sur la fenêtre. Remarquez que selon la vitesse de déplacement de la souris, le tracé est plus ou moins foncé. |
|
V-D. Obtenir un tracé continu▲
Afin d'avoir un tracé continu, nous aurons besoin de variables supplémentaires :
TForm1 = class(TForm)
...
private
{ private declarations }
image: TBGRABitmap;
mouseDrawing: boolean;
mouseOrigin: TPoint;mouseDrawing sera à vrai pendant le tracé (avec le bouton gauche appuyé), et mouseOrigin sera le point de départ du segment à dessiner.
Au moment du clic, le code devient un peu plus compliqué :
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
mouseDrawing := True;
mouseOrigin := Point(X,Y);
DrawBrush(X,Y,True);
end;
end;|
On initialise le tracé en précisant la position de départ. Ensuite, on dessine un segment complet (notez le nouveau paramètre à DrawBrush). En effet, au début, le segment est complet ce qui dans le cas d'un segment de longueur zéro correspond à un disque. |
|
|
Au fur et à mesure, on ajoute la nouvelle partie tracée, qui est un segment ouvert. |
|
Voilà pourquoi nous avons besoin d'un nouveau paramètre pour la fonction DrawBrush, qui devient :
procedure TForm1.DrawBrush(X, Y: Integer; Closed: Boolean);
const brushRadius = 20;
begin
image.DrawLineAntialias(X,Y,mouseOrigin.X,mouseOrigin.Y,
BGRA(0,0,0,128),brushRadius, Closed);
mouseOrigin := Point(X,Y);
PaintImage;
end;On transmet à DrawLineAntialias le paramètre Closed, indiquant si le segment est complet. Notez l'ordre des coordonnées. Le départ du segment et son point d'arrivée sont échangés. En effet, pour DrawLineAntialias, c'est la fin du segment qui est ouverte, alors que dans notre cas, c'est le début du segment qui est ouvert.
Il faut mettre à jour la définition de DrawBrush dans l'interface.
Le gestionnaire MouseMove devient :
procedure TForm1.FormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
begin
if mouseDrawing then DrawBrush(X,Y,False);
end;Enfin, il faut ajouter un gestionnaire MouseUp pour mettre à jour mouseDrawing :
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
mouseDrawing := False;
end;V-E. Résultat▲
Code complet :
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
BGRABitmap, BGRABitmapTypes;
type
{ TForm1 }
TForm1 = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseMove(Sender: TObject;
Shift: TShiftState; X, Y: Integer);
procedure FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ private declarations }
image: TBGRABitmap;
mouseDrawing: boolean;
mouseOrigin: TPoint;
procedure DrawBrush(X, Y: Integer; Closed: boolean);
procedure PaintImage;
public
{ public declarations }
end;
var
Form1: TForm1;
implementation
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
image := TBGRABitmap.Create(640,480,BGRAWhite);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
image.free;
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
begin
mouseDrawing := True;
mouseOrigin := Point(X,Y);
DrawBrush(X,Y,True);
end;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
if mouseDrawing then DrawBrush(X,Y,False);
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if Button = mbLeft then
mouseDrawing := False;
end;
procedure TForm1.FormPaint(Sender: TObject);
begin
PaintImage;
end;
procedure TForm1.DrawBrush(X, Y: Integer; Closed: Boolean);
const brushRadius = 20;
begin
image.DrawLineAntialias(X,Y,mouseOrigin.X,mouseOrigin.Y,BGRA(0,0,0,128),
brushRadius,Closed);
mouseOrigin := Point(X,Y);
PaintImage;
end;
procedure TForm1.PaintImage;
begin
image.Draw(Canvas,0,0,True);
end;
initialization
{$I UMain.lrs}
end.À l'exécution du programme, le tracé est presque uniforme :
VI. Accès direct aux pixels (Scanline)▲
L'intérêt particulier de BGRABitmap est de proposer un accès direct au pixel très simple d'utilisation. Les données sont accessibles comme une suite de TBGRAPixel, une structure qui contient 4 octets, un pour chaque canal.
Créez un nouveau projet et ajoutez la référence à BGRABitmap, de la même façon que dans le premier tutoriel.
Avec l'inspecteur d'objet, ajoutez un gestionnaire OnPaint et écrivez :
procedure TForm1.FormPaint(Sender: TObject);
var x,y: integer;
p: PBGRAPixel;
image: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
for y := 0 to image.Height-1 do
begin
p := image.Scanline[y];
for x := 0 to image.Width-1 do
begin
p^.red := x*256 div image.Width;
p^.green := y*256 div image.Height;
p^.blue := 0;
p^.alpha := 255;
inc(p);
end;
end;
image.InvalidateBitmap; // changé par accès direct
image.Draw(Canvas,0,0,True);
image.free;
end;Cette procédure crée une image de la même taille que la zone cliente disponible. Ensuite, les boucles parcourent tous les pixels pour calculer un dégradé bidimensionnel. Finalement l'image est affichée et libérée.
Pour accéder aux données de l'image, vous pouvez soit utiliser Data, si vous ne vous souciez pas de l'ordre des lignes, ou bien Scanline pour accéder à une ligne spécifique. À l'intérieur d'une ligne, les pixels sont rangés de gauche à droite.
Ici, chaque composante est définie :
p^.red := x*256 div image.Width;Définit une composante de rouge variant de 0 à 255 de gauche à droite. La valeur maximale image.Width n'est jamais atteinte par x, alors la composante rouge n'atteint jamais 256.
À l'exécution, vous devriez voir une fenêtre avec un dégradé où les coins sont noir, rouge, jaune et vert. Quand vous redimensionnez la fenêtre, le dégradé est aussi redimensionné.
VI-A. Espace de couleur HSLA▲
Vous pouvez utiliser la teinte (hue), la saturation et la luminosité (lightness). Pour cela, déclarez un pixel THSLAPixel. Les valeurs vont de 0 à 65535. Pour le convertir en RGB standard, utilisez HSLAToBGRA.
La teinte correspond à la couleur qui parcourt l'arc-en-ciel. La saturation correspond au niveau de coloration allant de gris aux couleurs vives ou blanches. La luminosité correspond à la clarté de la couleur, allant de noir à blanc.
Voilà par exemple comment afficher l'ensemble des couleurs possibles ayant une luminosité de 32768, c'est-à -dire les couleurs vives et les couleurs grises :
procedure TForm1.FormPaint(Sender: TObject);
var x,y: integer;
p: PBGRAPixel;
image: TBGRABitmap;
hsla: THSLAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
hsla.lightness := 32768;
hsla.alpha := 65535;
for y := 0 to image.Height-1 do
begin
p := image.Scanline[y];
hsla.saturation := y*65536 div image.Height;
for x := 0 to image.Width-1 do
begin
hsla.hue := x*65536 div image.Width;
p^:= HSLAToBGRA(hsla);
inc(p);
end;
end;
image.InvalidateBitmap; // changé par accès direct
image.Draw(Canvas,0,0,True);
image.free;
end;Ici la saturation change selon la position verticale, et la teinte change selon la position horizontale.
VII. Couches et masques▲
Ce chapitre montre comment utiliser les couches et les masques. Les couches sont simplement une série d'images empilées les unes sur les autres. La dernière couche, au sommet de la pile, cache partiellement les couches en dessous, et ainsi de suite.
VII-A. Notions sur les masques▲
Un masque est une image en tons de gris. Quand on applique un masque sur une image, les parties de l'image qui se superposent avec les parties noires du masque sont effacées et deviennent transparentes, tandis que les parties qui se superposent avec les parties blanches du masque sont conservées. En d'autres termes, le masque est semblable à un canal alpha définissant une opacité. Si la valeur du masque est à zéro, cela se traduit par une transparence, et si la valeur du masque est à 255, cela se traduit par une opacité.
|
|
Dans cet exemple, l'image de départ est en haut à gauche, le masque est en haut à droite, et le résultat de l'application du masque sur l'image est en bas à gauche. |
Cet exemple peut être généré à partir du code suivant :
var temp,tex,mask: TBGRABitmap;
begin
temp:= TBGRABitmap.Create(640,480,ColorToBGRA(ColorToRGB(clBtnFace)));
//chargement d'une texture et redimensionnement
tex := TBGRABitmap.Create('texture.png');
BGRAReplace(tex,tex.Resample(128,80));
//on affiche l'image en haut à gauche
temp.PutImage(10,10,tex,dmDrawWithTransparency);
//création d'un masque avec une ellipse et un rectangle
mask := TBGRABitmap.Create(128,80,BGRABlack);
mask.FillEllipseAntialias(40,40,30,30,BGRAWhite);
mask.FillRectAntialias(60,40,100,70,BGRAWhite);
//on affiche le masque en haut à droite
temp.PutImage(150,10,mask,dmDrawWithTransparency);
//on applique le masque à l'image
tex.ApplyMask(mask);
//on affiche l'image résultante en bas à gauche
temp.PutImage(10,100,tex,dmDrawWithTransparency);
mask.Free;
tex.Free;
//on affiche le tout à l'écran
image.Draw(Canvas,0,0,True);
image.Free;
end;VII-B. Effacement de parties de l'image▲
On peut aussi effacer des parties d'une image avec les fonctions dont le nom commence par Erase. Ces fonctions permettent d'effacer une ellipse, un rectangle, etc. Cela signifie que la partie concernée de l'image devient transparente. On peut donc dessiner un trou dans une image. Si le paramètre alpha est à 255, le trou est complètement transparent, sinon, la partie devient semi-transparente.
|
|
Ici une ellipse est effacée à gauche avec un paramètre alpha de 255, et une autre ellipse à droite est effacée avec un paramètre alpha à 128. |
Code correspondant dans OnPaint :
var image,tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(640,480, ColorToBGRA(ColorToRGB(clBtnFace)));
//chargement d'une texture et redimensionnement
tex := TBGRABitmap.Create('texture.png');
BGRAReplace(tex,tex.Resample(128,80));
//on affiche l'image en haut à gauche
image.PutImage(10,10,tex,dmDrawWithTransparency);
tex.EraseEllipseAntialias(40,40,30,30,255);
tex.EraseEllipseAntialias(80,40,30,30,128);
//on affiche l'image modifiée en bas à gauche
image.PutImage(10,100,tex,dmDrawWithTransparency);
tex.Free;
//on affiche le tout à l'écran
image.Draw(Canvas,0,0,True);
image.Free;
end;VII-C. Exemple d'utilisation▲
Créez un nouveau projet et ajoutez la référence à BGRABitmap. Avec l'inspecteur de projet, ajouter un gestionnaire OnPaint :
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
size: single;
procedure DrawMoon;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.FillEllipseAntialias(layer.Width/2,layer.Height/2,size*0.4,size*0.4,
BGRA(224,224,224,128));
layer.EraseEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,
size*0.3,size*0.3,255);
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
//calcul la place disponible dans les deux directions
if image.Height < image.Width then
size := image.Height
else
size := image.Width;
//dessine un ciel bleu
image.GradientFill(0,0,image.Width,image.Height,
BGRA(128,192,255),BGRA(0,0,255),
gtLinear,PointF(0,0),PointF(0,image.Height),
dmSet);
DrawMoon;
image.Draw(Canvas,0,0,True);
image.free;
end;La procédure crée une image et la remplit avec un dégradé bleu. Il s'agit de la couche d'arrière-plan.
La procédure DrawMoon crée une couche, dessine une lune dessus. D'abord un disque blanc est dessiné, puis un plus petit disque est soustrait. Finalement, cette couche est fusionnée avec l'arrière-plan.
À l'exécution, vous devriez voir un ciel bleu avec une lune. Quand vous redimensionnez la fenêtre, l'image est aussi redimensionnée.
VII-C-1. Ajout d'un soleil▲
Dans l'événement OnPaint, ajouter la sous-procédure :
procedure DrawSun;
var layer,mask: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,0),BGRA(255,0,0),
gtRadial,PointF(layer.Width/2,layer.Height/2-size*0.15),
PointF(layer.Width/2+size*0.45,layer.Height/2-size*0.15),
dmSet);
mask := TBGRABitmap.Create(layer.Width,layer.Height,BGRABlack);
mask.FillEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,
size*0.25,size*0.25,BGRAWhite);
layer.ApplyMask(mask);
mask.Free;
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;Cette procédure crée un dégradé radial de rouge et orange et applique un masque circulaire. Cela donne un disque coloré. Finalement, le disque est fusionné avec le fond.
Ajoutez un appel à cette procédure après la lune.
À l'exécution, vous devriez voir un ciel bleu avec une lune et un soleil. Quand la fenêtre est redimensionnée, l'image est aussi redimensionnée.
VII-C-2. Ajout d'une lumière▲
Ajoutez la sous-procédure suivante dans l'événement OnPaint :
procedure ApplyLight;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,255),BGRA(64,64,64),
gtRadial,PointF(layer.Width*5/6,layer.Height/2),
PointF(layer.Width*1/3,layer.Height/4),
dmSet);
image.BlendImage(0,0,layer,boMultiply);
layer.Free;
end;Cette procédure dessine une couche avec un dégradé radial blanc. Elle est ensuite appliquée à l'image par multiplication.
À l'exécution, vous devriez voir un ciel bleu avec une lune et un soleil, avec un effet de lumière.
VII-C-3. Résumé du code▲
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
size: single;
procedure DrawMoon;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.FillEllipseAntialias(layer.Width/2,layer.Height/2,
size*0.4,size*0.4,BGRA(224,224,224,128));
layer.EraseEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,
size*0.3,size*0.3,255);
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;
procedure DrawSun;
var layer,mask: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,0),BGRA(255,0,0),
gtRadial,PointF(layer.Width/2,layer.Height/2-size*0.15),
PointF(layer.Width/2+size*0.45,layer.Height/2-size*0.15),
dmSet);
mask := TBGRABitmap.Create(layer.Width,layer.Height,BGRABlack);
mask.FillEllipseAntialias(layer.Width/2+size*0.15,layer.Height/2,
size*0.25,size*0.25,BGRAWhite);
layer.ApplyMask(mask);
mask.Free;
image.PutImage(0,0,layer,dmDrawWithTransparency);
layer.Free;
end;
procedure ApplyLight;
var layer: TBGRABitmap;
begin
layer := TBGRABitmap.Create(image.Width,image.Height);
layer.GradientFill(0,0,layer.Width,layer.Height,
BGRA(255,255,255),BGRA(64,64,64),
gtRadial,PointF(layer.Width*5/6,layer.Height/2),
PointF(layer.Width*1/3,layer.Height/4),
dmSet);
image.BlendImage(0,0,layer,boMultiply);
layer.Free;
end;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
if image.Height < image.Width then
size := image.Height
else
size := image.Width;
image.GradientFill(0,0,image.Width,image.Height,
BGRA(128,192,255),BGRA(0,0,255),
gtLinear,PointF(0,0),PointF(0,image.Height),
dmSet);
DrawMoon;
DrawSun;
ApplyLight;
image.Draw(Canvas,0,0,True);
image.free;
end;VIII. Styles de lignes▲
Créez un nouveau projet et ajoutez un gestionnaire OnPaint :
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)));
c := ColorToBGRA(ColorToRGB(clWindowText));
image.RectangleAntialias(80,80,300,200,c,50);
image.Draw(Canvas,0,0,True);
image.free;
end;A l'exécution, vous devriez obtenir un rectangle avec un pinceau noir épais :
VIII-A. Styles de jointure▲
Si vous voulez des coins ronds, vous pouvez spécifier :
image.JoinStyle := pjsRound;
Vous pouvez mélanger les styles de jointures dans un même rectangle comme ceci :
image.FillRoundRectAntialias(80,80,300,200, 20,20, c,
[rrTopRightSquare,rrBottomLeftSquare]);En effet, cette fonction utilise des coins ronds par défaut, mais vous pouvez les remplacer par des coins carrés ou en biseau. Vous devriez obtenir l'image suivante.
VIII-B. Style de pinceau▲
Vous pouvez dessiner une ligne en pointillé comme cela :
image.JoinStyle := pjsBevel;
image.PenStyle := psDot;
image.DrawPolyLineAntialias([PointF(40,200),PointF(120,100),
PointF(170,140),PointF(250,60)],
c,10);Ici, une jointure en biseau est utilisée, mais on peut tracer une ligne pointillée avec les autres styles de jointures.
|
|
Notez que l'extrémité de la ligne est arrondie. |
VIII-C. Extrémités des lignes▲
Vous pouvez dessiner une polyligne avec des extrémités carrées comme cela :
image.JoinStyle := pjsBevel;
image.LineCap := pecSquare;
image.PenStyle := psSolid;
image.DrawPolyLineAntialias([PointF(40,200),PointF(120,100),
PointF(170,140),PointF(250,60)],
c,10);
Vous pouvez dessiner une ligne qui est ouverte, c'est-à -dire que la fin de la ligne est arrondie à l'intérieur :
image.DrawPolyLineAntialias([PointF(40,200),PointF(120,100),
PointF(170,140),PointF(250,60)],
c,10,False);
De cette façon, vous pouvez connecter des lignes les unes après les autres sans dessiner la jonction deux fois, ce qui est utile avec le dessin semi-transparent. Vous pouvez comparer le résultat comme cela :
c := BGRA(0,0,0,128);
image.DrawLineAntialias(40,150, 120,50, c, 10);
image.DrawLineAntialias(120,50, 170,90, c, 10);
image.DrawLineAntialias(170,90, 250,10, c, 10);
image.DrawLineAntialias(40,250, 120,150, c, 10, False);
image.DrawLineAntialias(120,150, 170,190, c, 10, False);
image.DrawLineAntialias(170,190, 250,110, c, 10, True);
IX. Splines▲
Ce chapitre traite du tracé de courbes à partir d'une suite de points.
Dans un nouveau projet, ajoutez un gestionnaire OnPaint avec :
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
pts: array of TPointF;
storedSpline: array of TPointF;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)));
c := ColorToBGRA(ColorToRGB(clWindowText));
//rectangular polyline
setlength(pts,4);
pts[0] := PointF(50,50);
pts[1] := PointF(150,50);
pts[2] := PointF(150,150);
pts[3] := PointF(50,150);
image.DrawPolylineAntialias(pts,BGRA(255,0,0,150),1);
//compute spline points and draw as a polyline
storedSpline := image.ComputeOpenedSpline(pts);
image.DrawPolylineAntialias(storedSpline,c,1);
image.Draw(Canvas,0,0,True);
image.free;
end;Il y a deux lignes qui dessinent la spline. La première calcule les points de la spline, et la seconde les dessine. Notez qu'il y a une fonction spécifique pour les splines ouvertes.
Ajoutons le dessin d'une spline fermée. Avant image.Draw, ajoutez ces lignes :
for i := 0 to 3 do
pts[i].x += 200;
image.DrawPolylineAntialias(pts,BGRA(255,0,0,150),1);
storedSpline := image.ComputeClosedSpline(pts);
image.DrawPolygonAntialias(storedSpline,c,1);Allez avec le curseur texte sur l'identifiant 'i' et appuyez Ctrl-Shift-C pour ajouter la déclaration de la variable. Cette boucle déplace les points vers la droite.
Les deux nouvelles lignes dessinent une spline fermée. Notez la fonction spécifique pour calculer une spline fermée et l'appel à DrawPolygonAntialias.
Vous pouvez éviter d'utiliser une variable pour stocker les points de la spline comme cela :
image.DrawPolygonAntialias(image.ComputeClosedSpline(pts),c,1);Cependant, si vous faites cela, vous ne pouvez pas utiliser les points calculés plus d'une fois, ils devront être recalculés à chaque fois que vous les utilisez.
À l'exécution, l'application dessine deux splines, une ouverte à gauche et une fermée à droite.
Notez que la spline passe par tous les points. Si vous voulez que la courbe reste à l'intérieur, ou bien définir des tangentes, vous devez définir des points de contrôle, qui sont disponibles avec les courbes de Bézier.
Ajoutons une courbe de Bézier. Avant image.Draw, ajoutez ces lignes :
StoredSpline := image.ComputeBezierSpline(
[BezierCurve(PointF(50,50), PointF(150,50), PointF(150,100)),
BezierCurve(PointF(150,100), PointF(150,150), PointF(50,150))]);
image.DrawPolylineAntialias(storedSpline,c,2);La fonction BezierCurve définit une courbe avec une origine et une destination, et un ou deux points de contrôle. Dans l'exemple il n'y a qu'un point de contrôle. Les points de contrôles sont définis de façon à ce que la courbe soit tangente au rectangle défini précédemment.
Une spline Bézier est simplement une suite de courbes de Bézier. Ainsi la fonction ComputeBezierSpline concatène un tableau de courbes de Bézier. Ici nous construisons un joli demi-tour avec deux courbes.
À l'exécution, vous devriez voir une courbe de Bézier en gras à l'intérieur du rectangle gauche.
X. Écrire du texte▲
Vous pouvez dessiner un texte simple comme cela :
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)) );
//récupère la couleur de texte par défaut
c := ColorToBGRA(ColorToRGB(clBtnText));
image.FontHeight := 30;
image.FontAntialias := true;
image.FontStyle := [fsBold];
image.TextOut(ClientWidth-5,5,'Hello world',c,);
image.SetPixel(5,5,c);
image.Draw(Canvas,0,0,True);
image.free;
end;Ici, la taille de police est de 30 pixels, avec antialiasing. Utiliser l'antialiasing pour le texte est plus lent, mais plus joli.
Le coin en haut à gauche du texte est à la coordonnée (5,5). Cette origine est montrée avec un SetPixel.
Il est possible de spécifier un alignement :
image.TextOut(ClientWidth-5,5,'Hello world',c,taRightJustify);
image.SetPixel(ClientWidth-5,5,c);Maintenant l'origine est sur le côté droit de la fenêtre, et le texte est à aligner sur la droite.
Il est aussi facile de dessiner du texte tourné. Pour cela, utilisez TextOutAngle ou bien la propriété FontOrientation :
image.TextOutAngle(30,5,-450,'Hello world',c, taLeftJustify);
image.SetPixel(30,5,c);L'angle est en dixième de degrés et les valeurs positives sont dans le sens inverse des aiguilles d'une montre. Ceci est une convention pour être compatible avec la propriété Orientation de l'objet Font du canvas standard.
Remarquez à présent où est l'origine du texte (le pixel ajouté).
X-A. Texte avec retour à la ligne▲
Il y a une version facile à utiliser de TextRect :
image.TextRect(rect(5,5,ClientWidth-5,ClientHeight-5),
'This is a text that should be word wrapped',
taCenter,tlCenter,c);
image.Rectangle(rect(5,5,ClientWidth-5,ClientHeight-5), c, dmSet);Les paramètres sont :
- le rectangle englobant (il y a un clipping);
- le texte;
- l'alignement horizontal;
- l'alignement vertical;
- la couleur.
Les alignements sont définis dans les unités Graphics et Classes.
X-B. Effets sur le texte▲
Vous pouvez dessiner un texte avec une ombre floue avec TextShadow de l'unité BGRAGradients :
var
image,txt: TBGRABitmap;
grad: TBGRAGradientScanner;
c: TBGRAPixel;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)) );
c := ColorToBGRA(ColorToRGB(clBtnText));
txt := TextShadow(ClientWidth,ClientHeight,'Hello world',30,c,
BGRABlack,5,5,5);
image.PutImage(0,0,txt,dmDrawWithTransparency);
txt.Free;
image.Draw(Canvas,0,0,True);
image.free;
end;La procédure TextShadow crée une image qui contient le texte avec une ombre. Les paramètres sont :
- la taille de l'image;
- le texte;
- la hauteur de la police;
- la couleur;
- la couleur de l'ombre;
- le décalage et le rayon de flou de l'ombre.
N'oubliez pas de libérer l'image après utilisation.
Comme les autres fonctions, vous pouvez passer en paramètre un dégradé ou une texture pour remplir le texte. Voici un exemple :
uses BGRAGradientScanner;
var
image: TBGRABitmap;
grad: TBGRAGradientScanner;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)) );
grad := TBGRAGradientScanner.Create(BGRA(255,255,0),BGRA(255,0,0),
gtLinear,PointF(0,0),PointF(0,35),
True,True);
image.FontHeight := 30;
image.FontAntialias := true;
image.FontStyle := [fsBold];
image.TextOut(6,6,'Hello world',BGRABlack); //draw a black border
image.TextOut(5,5,'Hello world',grad); //draw gradient text
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;D'abord un dégradé sinusoïdal horizontal est créé, de couleur jaune et rouge. Il est ensuite utilisé comme texture.
XI. Textures▲
Créez un nouveau projet et ajoutez la référence à BGRABitmap.
La texture la plus simple est hachurée, semblable aux styles de l'objet Brush du canvas standard.
Avec l'inspecteur d'objet, ajoutez un gestionnaire OnPaint et écrivez :
procedure TForm1.FormPaint(Sender: TObject);
var
image,tex: TBGRABitmap;
c: TBGRAPixel;
x,y,rx,ry: single;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)));
c := ColorToBGRA(ColorToRGB(clWindowText));
//coordonnées de l'ellipse
x := 150;
y := 100;
rx := 100;
ry := 50;
//charge un pinceau "diagcross" avec un motif blanc sur fond orange
tex := image.CreateBrushTexture(bsDiagCross,BGRAWhite, BGRA(255,192,0))
as TBGRABitmap;
image.FillEllipseAntialias(x,y,rx-0.5,ry-0.5,tex);
image.EllipseAntialias(x,y,rx,ry,c,1); //contour
tex.Free;
image.Draw(Canvas,0,0,True);
image.free;
end;Comme vous pouvez le voir, une texture est juste une image. Pour remplir une ellipse avec une texture, passez juste la texture en paramètre à la place de la couleur.
Deux commandes définissent l'ellipse. La première est le remplissage, la seconde est le contour. Notez que le rayon est 0,5 pixel plus petit pour le remplissage. En effet, quand la taille du pinceau est 1, le rayon intérieur est 0,5 plus petit et le rayon extérieur 0,5 pixel plus grand.
En utilisant la commande pour le contour, nous dessinons une ellipse avec texture et un bord. Mais si la fonction de contour n'est pas disponible, vous pouvez aussi utiliser une autre commande de remplissage avec un plus grand rayon et la couleur du bord, puis un rayon plus petit pour l'intérieur.
Ajoutez les lignes suivantes avant tex.Free :
image.RoundRectAntialias(x-rx-10,y-ry-10,x+rx+10,y+ry+10,20,20,c,11);
image.RoundRectAntialias(x-rx-10,y-ry-10,x+rx+10,y+ry+10,20,20,tex,9);La première commande dessine un rectangle arrondi large (un pinceau de largeur 11) qui inclut le bord. La seconde commande remplit la texture avec une largeur plus petite (9). Cela fonctionne parfaitement tant que la texture n'est pas transparente.
Pour dessiner des polygones avec une jonction parfaite entre eux, utilisez l'objet TBGRAMultishapeFiller de l'unité BGRAPolygon.
Vous devriez obtenir un rectangle arrondi avec une ellipse à l'intérieur. Chaque forme est remplie avec une texture orange.
XI-A. Génération de textures▲
Il est possible de générer des textures aléatoires répétables en utilisant CreateCyclicPerlinNoiseMap, qui peut être trouvé dans l'unité BGRAGradient.
Avec l'inspecteur d'objet, définissez un gestionnaire OnPaint avec :
procedure TForm1.FormPaint(Sender: TObject);
var
image,tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
tex := CreateCyclicPerlinNoiseMap(100,100);
image.FillRect(0,0,image.Width,image.Height, tex);
tex.free;
image.Draw(Canvas,0,0,True);
image.free;
end;Ce code crée une texture de 100x100, et remplit la fenêtre avec. Vous devriez obtenir quelque chose comme cela :
C'est très noir et blanc. Vous pouvez ajouter quelques couleurs. Pour cela, nous avons d'une fonction pour interpoler les valeurs. En voici une :
function Interp256(value1,value2,position: integer): integer; inline;
begin
result := (value1*(256-position) + value2*position) shr 8;
end;Cette fonction calcule une valeur allant de value1 à value2. Position est un nombre entre 0 et 256 indiquant si on se rapproche de la deuxième valeur. L'expression « shr 8 » est un équivalent optimisé de « div 256 » pour des valeurs positives. C'est un décalage binaire de 8 chiffres.
La directive inline précise que le code de la fonction serait directement incorporé où elle est utilisé, évitant de faire un appel de fonction, ceci afin d'accélérer l'exécution.
Nous voulons interpoler des couleurs, alors écrivons une fonction pour cela :
function Interp256(color1,color2: TBGRAPixel;
position: integer): TBGRAPixel; inline;
begin
result.red := Interp256(color1.red,color2.red, position);
result.green := Interp256(color1.green,color2.green, position);
result.blue := Interp256(color1.blue,color2.blue, position);
result.alpha := Interp256(color1.alpha,color2.alpha, position);
end;C'est assez évident : chaque composante est interpolée entre la valeur pour color1 et pour color2.
Maintenant, nous avons tout le nécessaire pour faire de la couleur. Après CreatePerlinNoiseMap, ajoutez les lignes suivantes :
p := tex.Data;
for i := 0 to tex.NbPixels-1 do
begin
p^ := Interp256( BGRA(0,128,0), BGRA(192,255,0), p^.red );
inc(p);
end;Vous aurez besoin des variables 'p' et 'i', alors cliquez sur chacune et pressez Ctrl-Shift-C.
Cette boucle prend chaque pixel et crée une couleur de vert foncé jusqu'à jaune-vert.
Nous obtenons une couleur vert-arbre :
XI-A-1. Utilisation de seuils▲
Au lieu de varier continuellement, la couleur peut être changée avec un seuil. Par exemple, nous pouvons délimiter la mer et des îles :
p := tex.Data;
for i := 0 to tex.NbPixels-1 do
begin
if p^.red > 196 then
p^ := BGRA(192,160,96) else //mer
p^ := BGRA(0,128,196); //île
inc(p);
end;Nous pouvons utiliser davantage de seuils. Voilà par exemple un camouflage militaire :
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
v := p^.red;
if v < 64 then p^:= BGRA(31,33,46) else
if v < 128 then p^:= BGRA(89,71,57) else
if v < 192 then p^:= BGRA(80,106,67) else
p^:= BGRA(161,157,121);
inc(p);
end;
XI-A-2. Fonction sinus▲
Nous pouvons appliquer la fonction sinus aux valeurs du bruit pour générer des oscillations. Créons pour cela une procédure :
function CreateCustomTexture(tx,ty: integer): TBGRABitmap;
var
colorOscillation: integer;
p: PBGRAPixel;
i: Integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1);
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
colorOscillation := round(((sin(p^.red*Pi/32)+1)/2)*256);
p^ := Interp256(BGRA(181,157,105),BGRA(228,227,180),colorOscillation);
inc(p);
end;
end;L'oscillation de couleur est une valeur entre 0 et 256. Elle est calculée à partir de l'intensité (p^.red). On y applique la fonction sinus avec une demi-période de 32. Cela donne un nombre entre -1 et 1. Pour le ramener dans l'intervalle 0..1, nous ajouter 1 et divisons par 2. Enfin, nous multiplions par 256 pour avoir un entier pour Interp256.
La procédure OnPaint devient plus simple :
var
image,tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)));
tex := CreateCustomTexture(100,100);
image.FillRoundRectAntialias(20,20,300,200,20,20,tex);
image.RoundRectAntialias(20,20,300,200,20,20,BGRABlack,1);
tex.free;
image.Draw(Canvas,0,0,True);
image.free;
end;Vous devriez obtenir une image ressemblant à cela :
Maintenant, si on veut que cela ressemble à du marbre, nous avons besoin de moins d'oscillation. Par exemple, nous pouvons utiliser une demi-période de 80. Sur le marbre, les parties sombres sont très fines. Nous pouvons déformer les oscillations en appliquant une fonction 'puissance' : un exposant entre 0 et 1 rendra la valeur plus proche de 1 et un exposant plus grand que 1 rendra la valeur plus proche de 0. Changeons donc l'oscillation dans CreateCustomTexture :
colorOscillation := round(power((sin(p^.red*Pi/80)+1)/2,0.2)*256);Nous avons alors quelque chose qui ressemble beaucoup plus à du marbre :
Une texture de bois peut être réalisée avec des fonctions sinus également. La texture de bois contient deux oscillations, une avec des couleurs claires, et une autre avec des couleurs foncées. Alors nous devons appliquer une variation globale entre ces oscillations :
function CreateWoodTexture(tx,ty: integer): TBGRABitmap;
var
colorOscillation, globalColorVariation: integer;
p: PBGRAPixel;
i: Integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty);
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
colorOscillation := round( sqrt((sin(p^.red*Pi/16)+1)/2)*256 );
globalColorVariation := p^.red;
p^:= Interp256(Interp256(BGRA(247,188,120),BGRA(255,218,170),
colorOscillation),
Interp256(BGRA(157,97,60),BGRA(202,145,112),
colorOscillation),globalColorVariation);
inc(p);
end;
end;Ici, la demi-période est 16 et la variation globale est simplement l'intensité. Le résultat ressemble à cela :
La plupart du temps, une texture de bois est orientée selon un axe. Pour faire cela, à la place d'utiliser l'intensité seulement comme position globale, nous avons besoin de la combiner avec la position x :
function CreateVerticalWoodTexture(tx,ty: integer): TBGRABitmap;
var
globalPos: single;
colorOscillation, globalColorVariation: integer;
p: PBGRAPixel;
i: Integer;
x: integer;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty);
p := result.Data;
x := 0;
for i := 0 to result.NbPixels-1 do
begin
globalPos := p^.red*Pi/32 + x*2*Pi/tx*8;
colorOscillation := round(sqrt((sin(globalPos)+1)/2)*256);
globalColorVariation := round(sin(globalPos/8)*128+128);
p^:= Interp256(Interp256(BGRA(247,188,120),BGRA(255,218,170),
colorOscillation),
Interp256(BGRA(157,97,60),BGRA(202,145,112),
colorOscillation), globalColorVariation);
inc(p);
inc(x);
if x = tx then x := 0;
end;
end;Nous obtenons cela :
XI-B. Placage de textures▲
Regardons ce qu'il arrive si on dessine un polygone avec une texture en utilisant le placage par défaut :
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
tex: TBGRABitmap;
begin
//fond noir
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
tex:= TBGRABitmap.Create('image.png'); //charge une image
image.FillPolyAntialias([PointF(110,10),PointF(250,10),
PointF(350,160), PointF(10,160)],
tex);
tex.Free;
image.Draw(Canvas,0,0,True); //dessine à l'écran
image.free;
end;Vous devriez obtenir quelque chose comme cela :
Comme vous pouvez le voir, l'image n'est pas déformée, elle est simplement découpée, comme lorsque l'on applique un masque.
Nous pouvons appliquer une transformation affine comme cela :
procedure TForm1.PaintImage;
var image: TBGRABitmap;
tex: TBGRABitmap;
affine: TBGRAAffineBitmapTransform;
begin
//fond noir
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
tex:= TBGRABitmap.Create('image.png'); //charge une image
//création d'une rotation de 45°
affine := TBGRAAffineBitmapTransform.Create(tex,True);
affine.RotateDeg(45);
//utiliser cette transformation comme paramètre à la place de tex
image.FillPolyAntialias([PointF(110,10),PointF(250,10),
PointF(350,160),PointF(10,160)],affine);
affine.Free;
tex.Free;
image.Draw(Canvas,0,0,True); //dessin à l'écran
image.free;
end;Vous devriez obtenir une image tournée à l'intérieur du polygone :
Comme précédemment, l'image est simplement répétée et découpée à la façon d'un masque.
XI-B-1. Placage linéaire▲
Le placage linéaire étire l'image linéairement le long des bords. Pour faire cela :
procedure TForm1.PaintImage;
var image: TBGRABitmap;
tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
tex:= TBGRABitmap.Create('image.png');
image.FillPolyLinearMapping(
[PointF(110,10),PointF(250,10),PointF(350,160),PointF(10,160)],
tex,
[PointF(0,0),PointF(tex.width-1,0),
PointF(tex.Width-1,tex.Height-1),PointF(0,tex.Height-1)],
true);
tex.Free;
image.Draw(Canvas,0,0,True);
image.free;
end;Pour faire le placage, nous utilisons FillPolyLinearMapping. De nouveaux paramètres sont apparus. Les coordonnées de la texture définissent pour chaque sommet du polygone, la position dans la texture. L'option d'interpolation est utilisée pour une meilleure qualité.
Maintenant, la texture est déformée selon la forme polygonale :
Afin d'avoir un antialiasing du polygone, il est possible dans ce cas d'utiliser FillQuadLinearMappingAntialias.
XI-B-2. Placage avec perspective▲
Le placage avec perspective permet de définir pour chaque point sa profondeur.
procedure TForm1.PaintImage;
var image: TBGRABitmap;
tex: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,BGRABlack );
tex:= TBGRABitmap.Create('image.png');
image.FillPolyPerspectiveMapping(
[PointF(110,10),PointF(250,10),PointF(350,160),PointF(10,160)],
[75, 75, 50, 50],
tex,
[PointF(0,0),PointF(tex.width-1,0),
PointF(tex.Width-1,tex.Height-1),PointF(0,tex.Height-1)],
true);
tex.Free;
image.Draw(Canvas,0,0,True);
image.free;
end;Ici la profondeur est de 75 pour le haut du polygone et 50 pour le bas. Cela signifie que le bas est plus proche de l'observateur, comme s'il était horizontal, comme un plancher.
Maintenant, on a l'impression que c'est un polygone en 3DÂ :
Avec ces techniques, il est possible de déformer une image et de dessiner des objets en 3D avec textures.
XII. Dégradés et transformations▲
On peut dessiner un dégradé avec la fonction GradientFill :
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
image.GradientFill(0,0,ClientWidth,ClientHeight,BGRA(0,0,0),BGRA(255,0,255),
gtDiamond,PointF(ClientWidth/2,ClientHeight/2),
PointF(ClientWidth/2,0),
dmSet);
image.Draw(Canvas,0,0,True);
image.free;
end;Il suffit d'un seul appel à la fonction GradientFill pour remplir l'image. Il faut juste prendre le temps de définir chaque paramètre :
- La zone rectangulaire à remplir;
- Les deux couleurs utilisées;
- Le type de gradient;
- Les points de contrôle du gradient;
- Le mode de dessin.
XII-A. Utiliser un scanner▲
Un scanner est une sorte de texture dont le contenu est généré à la demande. Il est possible de créer les mêmes dégradés qu'avec la fonction GradientFill, mais en l'utilisant comme texture :
uses BGRAGradientScanner;
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
grad: TBGRAGradientScanner;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
grad := TBGRAGradientScanner.Create(BGRA(0,0,255),BGRAWhite,gtRadial,
PointF(0,0),PointF(1,0),True,True);
image.Fill(grad);
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;On peut combiner une transformation et une texture de dégradé comme cela :
uses BGRAGradientScanner, BGRATransform;
procedure TForm1.FormPaint(Sender: TObject);
var image: TBGRABitmap;
grad: TBGRAGradientScanner;
affine: TBGRAAffineScannerTransform;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
grad := TBGRAGradientScanner.Create(BGRA(0,0,255),BGRAWhite,gtRadial,
PointF(0,0),PointF(1,0),True,True);
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(150,80);
affine.RotateDeg(-30);
affine.Translate(ClientWidth/2, ClientHeight/2);
image.Fill(affine);
affine.free;
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;Le dégradé de base est radial, centré à l'origine (0,0) et de rayon 1.
La transformation affine effectue les actions suivantes :
- étirer le dégradé à une taille de 150x80;
- tourner de 30 degrés dans le sens inverse des aiguilles d'une montre;
- centrer sur la fenêtre.
L'instruction Fill dessine le résultat sur l'image.
Vous devriez obtenir une ellipse avec un dégradé bleu et blanc.
Nous pouvons ajouter une autre transformation comme cela :
var image: TBGRABitmap;
grad: TBGRAGradientScanner;
affine: TBGRAAffineScannerTransform;
twirl: TBGRATwirlScanner;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
grad := TBGRAGradientScanner.Create(BGRA(0,0,255),BGRAWhite,gtRadial,
PointF(0,0),PointF(1,0), True,True);
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(150,80);
affine.RotateDeg(-30);
affine.Translate(ClientWidth/2, ClientHeight/2);
twirl := TBGRATwirlScanner.Create(affine,Point(ClientWidth div 2,
ClientHeight div 2),100);
image.Fill(twirl);
twirl.Free;
affine.free;
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;Ici, nous créons une transformation de twirl et l'appliquons à la précédente.
À présent, le centre du dégradé est tourbillonnant.
XII-B. Scanner personnalisé▲
Nous pouvons avoir besoin de créer notre propre générateur de dégradés. Voici par exemple un dégradé multiplicateur :
type
{ TBGRAMultiplyScanner }
TBGRAMultiplyScanner = class(TBGRACustomScanner)
function ScanAt(X, Y: Single): TBGRAPixel; override;
end;
{ TBGRAMultiplyScanner }
function TBGRAMultiplyScanner.ScanAt(X, Y: Single): TBGRAPixel;
function cycle512(value: integer): integer; inline;
begin
result := value and 511;
if result >= 256 then result := 511-result;
end;
var
mul: integer;
begin
mul := cycle512(round(x*y));
result := BGRA(mul,mul,mul,255);
end;Il est dérivé de TBGRACustomScanner afin d'être utilisé pour le remplissage, et la fonction ScanAt est remplacée (override). Elle calcule le produit des deux coordonnées et fait un cycle de 512 (de 0 à 255 puis de 255 à 0).
Dessinons-le à l'écran avec une simple transformation affine :
var image: TBGRABitmap;
grad: TBGRAMultiplyScanner;
affine: TBGRAAffineScannerTransform;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight, BGRABlack );
grad := TBGRAMultiplyScanner.Create;
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(6,4);
affine.Translate(ClientWidth/2, ClientHeight/2);
image.Fill(affine);
affine.free;
grad.free;
image.Draw(Canvas,0,0,True);
image.free;
end;Cela devrait ressembler à cela :
Ajoutez des couleurs et modifiant la procédure ScanAt du dégradé multiplicateur :
var
mul: integer;
begin
mul := round(x*y);
result := BGRA(cycle512(round(x*10)),cycle512(mul),cycle512(round(y*10)),255);
end;Les intensités rouge et bleue sont définies avec un cycle des positions x et y.
Enfin ajoutez une rotation :
affine := TBGRAAffineScannerTransform.Create(grad);
affine.Scale(6,4);
affine.RotateDeg(-30);
affine.Translate(ClientWidth/2, ClientHeight/2);
Le dégradé résultant peut-être utilisé comme une texture.
XIII. Éclairage de Phong▲
Ce tutoriel montre comment utiliser l'éclairage de Phong et comment créer des textures avec ce dernier.
Créez un nouveau projet. Pour utiliser l'éclairage Phong, vous devez initialiser une classe TPhongShading. Elle est située dans l'unité BGRAGradients.
Ajoutons la variable dans la définition de la fenêtre :
TForm1 = class(TForm)
...
phong: TPhongShading;Quand la fenêtre est créée, on crée la classe :
procedure TForm1.FormCreate(Sender: TObject);
begin
phong := TPhongShading.Create;
phong.LightPositionZ := 150;
phong.SpecularIndex := 20;
phong.AmbientFactor := 0.4;
phong.LightSourceIntensity := 250;
phong.LightSourceDistanceTerm := 200;
end;L'indice spéculaire indique la concentration de la lumière réfléchie. Le facteur ambiant indique l'éclairage de base. La variable LightSourceDistanceTerm indique la distance supplémentaire entre la lumière et l'objet.
Quand la fenêtre est détruite :
procedure TForm1.FormDestroy(Sender: TObject);
begin
phong.Free;
end;Quand l'image est peinte, on ajoute un objet avec éclairage de Phong :
var
image: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)));
phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
image.Draw(Canvas,0,0,True);
image.free;
end;Il y a d'autres fonctions de base avec éclairage de Phong comme dessiner un rectangle ou un rectangle arrondi.
Les paramètres de DrawSphere sont l'image de destination, les bornes de l'objet, l'altitude maximum et la couleur. Le diamètre de la sphère est 100 alors l'altitude maximum est un hémisphère de 50.
Finalement, quand la souris est déplacée, ce serait bien que la source de lumière suive :
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState;
X, Y: Integer);
begin
phong.LightPosition := point(X,Y);
FormPaint(Sender);
end;Quand vous lancez le programme, vous pouvez jouer avec la lumière sur la sphère :
XIII-A. Textures avec éclairage de Phong▲
La procédure suivante crée un carré de chocolat :
function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
var
square,map: TBGRABitmap;
phong: TPhongShading;
margin: integer;
begin
margin := tx div 20; //espace vide autour du carré
square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);
//crée une carte avec le carré au milieu
map := TBGRABitmap.Create(tx,ty,BGRABlack);
map.PutImage(margin,margin,square,dmDrawWithTransparency);
//applique un flou pour le rendre plus arrondi
BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
square.free;
//création de l'image résultante
result := TBGRABitmap.Create(tx,ty);
//utilisation de l'éclairage de Phong
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 200;
phong.AmbientFactor := 0.5;
phong.LightPosition := Point(-50,-100);
phong.LightPositionZ := 80;
//dessine une pièce de chocolat avec une altitude max de 20
phong.Draw(result,map,20,0,0,BGRA(86,41,38));
map.Free;
phong.Free;
end;Le module d'éclairage de Phong utilise une carte d'altitudes pour calculer les effets de lumière. Ici, la carte contient un carré.
Parmi les propriétés de l'éclairage, il y a LightSourceDistanceFactor et LightDestFactor. En mettant ces valeurs à zéro, on permet que la texture soit répétable. En effet, quand le facteur de distance est à zéro, la distance entre la lumière et l'objet n'est pas prise en compte, et quand le facteur de destination de la lumière est à zéro, la position de l'objet n'est pas prise en compte pour le calcul de l'angle de la lumière.
Quand la fenêtre est créée, on crée le morceau de chocolat :
chocolate := CreateChocolateTexture(80,80);Et quand la fenêtre est détruite :
chocolate.Free;Avant phong.DrawSphere dans l'événement OnPaint, ajoutez cette ligne :
image.FillRect(0,0,80*7,80*4,chocolate,dmSet);XIII-A-1. Code résultant▲
unit UMain;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, FileUtil, LResources, Forms, Controls, Graphics, Dialogs,
ExtCtrls, Buttons, BGRABitmap, BGRABitmapTypes, BGRAGradients;
type
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure FormMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
procedure FormPaint(Sender: TObject);
private
{ private declarations }
public
{ public declarations }
phong: TPhongShading;
chocolate: TBGRABitmap;
end;
var
Form1: TForm1;
implementation
function CreateChocolateTexture(tx,ty: integer): TBGRABitmap;
var
square,map: TBGRABitmap;
phong: TPhongShading;
margin: integer;
begin
margin := tx div 20;
square := CreateRectangleMap(tx-2*margin,ty-2*margin,tx div 8);
map := TBGRABitmap.Create(tx,ty,BGRABlack);
map.PutImage(margin,margin,square,dmDrawWithTransparency);
BGRAReplace(map,map.FilterBlurRadial(tx div 40,rbFast));
square.free;
result := TBGRABitmap.Create(tx,ty);
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 200;
phong.AmbientFactor := 0.5;
phong.LightPosition := Point(-50,-100);
phong.LightPositionZ := 80;
phong.Draw(result,map,20,0,0,BGRA(86,41,38));
map.Free;
phong.Free;
end;
{ TForm1 }
procedure TForm1.FormCreate(Sender: TObject);
begin
phong := TPhongShading.Create;
phong.LightPositionZ := 150;
phong.SpecularIndex := 20;
phong.AmbientFactor := 0.4;
phong.LightSourceIntensity := 250;
phong.LightSourceDistanceTerm := 200;
chocolate := CreateChocolateTexture(80,80);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
phong.Free;
chocolate.Free;
end;
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
begin
phong.LightPosition := point(X,Y);
FormPaint(Sender);
end;
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight,
ColorToBGRA(ColorToRGB(clBtnFace)));
image.FillRect(0,0,80*7,80*4,chocolate,dmSet);
phong.DrawSphere(image,rect(20,20,120,120),50,BGRA(255,0,0));
image.Draw(Canvas,0,0,True);
image.free;
end;
initialization
{$I UMain.lrs}
end.À l'exécution, vous devriez voir une plaquette de chocolat appétissante avec une grosse cerise :
XIII-B. Bruit de Perlin et éclairage de Phong▲
L'idée est de créer une carte avec un bruit de Perlin, et ensuite d'utiliser l'éclairage de phong pour le rendu. Voici comment créer une texture de pierre :
function CreateStoneTexture(tx,ty: integer): TBGRABitmap;
var
temp: TBGRABitmap;
phong: TPhongShading;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,0.6);
temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 100;
phong.LightPositionZ := 100;
phong.NegativeDiffusionFactor := 0.3;
phong.AmbientFactor := 0.5;
phong.Draw(result,temp,30,-2,-2,BGRA(170,170,170));
phong.Free;
temp.Free;
end;D'abord, on crée une carte cyclique. C'est important pour que la texture soit répétable. Mais ensuite, quand on appliquera l'effet Phong, on aura besoin de préciser que l'effet de lumière aussi soit cyclique. Alors, avec GetPart, on extrait la carte générée avec 2 pixels en plus sur chaque bord, ainsi le calcul de lumière sera appliqué convenablement.
L'appel à phong.Draw avec l'offset (-2,-2) dessine la carte à la position correcte, prenant en compte qu'on a ajouté 2 pixels.
Maintenant dans l'événement OnPaint :
procedure TForm1.FormPaint(Sender: TObject);
var
image: TBGRABitmap;
stone: TBGRABitmap;
begin
image := TBGRABitmap.Create(ClientWidth,ClientHeight);
stone := CreateStoneTexture(100,100);
image.Fill(stone);
stone.free;
image.Draw(Canvas,0,0,True);
image.free;
end;À l'exécution, vous devriez voir une fenêtre avec un fond de pierre.
XIII-B-1. Faire de l'eau▲
C'est presque la même procédure pour générer de l'eau :
function CreateWaterTexture(tx,ty: integer): TBGRABitmap;
const blurSize = 5;
var
temp: TBGRABitmap;
phong: TPhongShading;
begin
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
temp:= result.GetPart(rect(-blurSize,-blurSize,tx+blurSize,ty+blurSize))
as TBGRABitmap;
BGRAReplace(temp,temp.FilterBlurRadial(blurSize,rbFast));
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 150;
phong.LightPositionZ := 80;
phong.LightColor := BGRA(105,233,240);
phong.NegativeDiffusionFactor := 0.3;
phong.SpecularIndex := 20;
phong.AmbientFactor := 0.4;
phong.Draw(result,temp,20,-blurSize,-blurSize,BGRA(28,139,166));
phong.Free;
temp.Free;
end;La principale différence est qu'on applique un flou pour rendre l'eau ronde et qu'on définit une couleur pour la lumière.
XIII-B-2. Utilisation de seuils▲
Il est possible de ne garder qu'un sous-intervalle des altitudes, pour avoir une texture qui montre des traces de pas dans la neige :
function CreateSnowPrintTexture(tx,ty: integer): TBGRABitmap;
var
v: integer;
p: PBGRAPixel;
i: Integer;
temp: TBGRABitmap;
phong: TPhongShading;
begin
//ici la carte aléatoire est créée
result := CreateCyclicPerlinNoiseMap(tx,ty,1,1,1.2);
//à présent on applique les seuils
p := result.Data;
for i := 0 to result.NbPixels-1 do
begin
v := p^.red;
//si la valeur est au-dessus de 80 ou en dessous de 50,
//on la divise par 10 pour rendre la carte horizontale
if v > 80 then v := (v-80) div 10+80;
if v < 50 then v := 50-(50-v) div 10;
p^.red := v;
p^.green := v;
p^.blue := v;
inc(p);
end;
//pour que l'éclairage de Phong prenne en compte le cycle
temp:= result.GetPart(rect(-2,-2,tx+2,ty+2)) as TBGRABitmap;
//on applique un flou radial
BGRAReplace(temp,temp.FilterBlurRadial(2,rbFast));
phong := TPhongShading.Create;
phong.LightSourceDistanceFactor := 0;
phong.LightDestFactor := 0;
phong.LightSourceIntensity := 100;
phong.LightPositionZ := 100;
phong.NegativeDiffusionFactor := 0.3; //pour avoir des ombres
phong.Draw(result,temp,30,-2,-2,BGRAWhite);
phong.Free;
temp.Free;
end;