Developpez.com

Une très vaste base de connaissances en informatique avec
plus de 100 FAQ et 10 000 réponses à vos questions

BGRABitmap pour Lazarus

Dessin avec transparence et antialiasing

Le Canvas standard en Pascal propose un certain nombre de fonctions, mais la gestion de l'antialiasing ainsi que le dessin avec transparence sont difficiles à gérer.
De plus, l'accès direct aux pixels est plutôt lent.

La bibliothèque BGRABitmap a pour but de permettre un dessin avec antialiasing, de contrôler la transparence, de fusionner des couches, ajouter des effets...

Ce tutoriel propose de faire le tour des fonctionnalités de cette bibliothèque.

24 commentaires Donner une note à l'article (5)

Article lu   fois.

L'auteur

Profil ProSite personnel

Liens sociaux

Viadeo Twitter Facebook Share on Google+   

1. Notions

BGRABitmap est un ensembles 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ées 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.

1-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.

2. 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/

2-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 au 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.

2-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, creez 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é du 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.

3. 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 :

 
Sélectionnez
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).

3-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 :

 
Sélectionnez
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.

3-B. Résultat

Vous devriez obtenir le code suivant :

 
Sélectionnez
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.

Image non disponible

4. 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 :

 
Sélectionnez
  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 :

 
Sélectionnez
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 :

 
Sélectionnez
procedure TForm1.FormDestroy(Sender: TObject);
begin
  image.free;
end; 

4-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 :

 
Sélectionnez
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.

A l'exécution, vous devriez voir une fenêtre avec une image dessinée dedans au coin supérieur gauche.

Image non disponible

4-B. Centrer l'image

Vous pouvez centrer l'image sur la fenêtre. Pour cela, modifiez la procédure FormPaint :

 
Sélectionnez
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.

4-C. Étirer une image

Pour étirer une image, nous avons besoin de créer une image temporaire étirée :

 
Sélectionnez
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) :

 
Sélectionnez
stretched := image.Resample(ClientWidth,ClientHeight,rmSimpleStretch)
             as TBGRABitmap;

Vous pouvez choisir le filtre de rééchantillonage en utilisant la propriété ResampleFilter :

 
Sélectionnez
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.

5. 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 :

 
Sélectionnez
  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 :

 
Sélectionnez
procedure TForm1.FormCreate(Sender: TObject);
begin
  image := TBGRABitmap.Create(640,480,BGRAWhite);
end;

L'image est ainsi créée avec un 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.

5-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 :

 
Sélectionnez
procedure TForm1.FormPaint(Sender: TObject);
begin
  PaintImage;
end;

Ajoutez la procédure PaintImage :

 
Sélectionnez
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.

5-B. Gestion de la souris

Avec l'inspecteur d'objet, ajouter des gestionnaires pour les évènements MouseDown et MouseMove :

 
Sélectionnez
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 :

 
Sélectionnez
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).

5-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é. Image non disponible

5-D. Obtenir un tracé continu

Afin d'avoir un tracé continu, nous aurons besoin de variables supplémentaires :

 
Sélectionnez
  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é :

 
Sélectionnez
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. Image non disponible
Au fur et à mesure, on ajoute la nouvelle partie tracée, qui est un segment ouvert. Image non disponible

Voilà pourquoi nous avons besoin d'un nouveau paramètre pour la fonction DrawBrush, qui devient :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

 
Sélectionnez
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
                             Shift: TShiftState; X, Y: Integer);
begin
  if Button = mbLeft then
    mouseDrawing := False;
end;

5-E. Résultat

Code complet :

 
Sélectionnez
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.

A l'éxecution du programme, le tracé est presque uniforme :

Image non disponible

6. 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 ajouter 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 :

 
Sélectionnez
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. A l'intérieur d'un ligne, les pixels sont rangés de gauche à droite.

Ici, chaque composante est définie :

 
Sélectionnez
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.

A 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é.

Image non disponible

6-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 :

 
Sélectionnez
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.

Image non disponible

7. 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.

7-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 masques 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é.

Image non disponible 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 :

 
Sélectionnez
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;

7-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.

Image non disponible
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 :

 
Sélectionnez
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;

7-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 :

 
Sélectionnez
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 un 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.

A l'exécution, vous devriez voir un ciel bleu avec une lune. Quand vous redimensionnez la fenêtre, l'image est aussi redimensionnée.

Image non disponible

7-C-1. Ajout d'un soleil

Dans l'événement OnPaint, ajouter la sous-procédure :

 
Sélectionnez
  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.

A 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.

Image non disponible

7-C-2. Ajout d'une lumière

Ajoutez la sous-procédure suivante dans l'événement OnPaint :

 
Sélectionnez
  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é à l'image par multiplication.

A l'exécution, vous devriez voir un ciel bleu avec une lune et un soleil, avec un effet de lumière.

Image non disponible

7-C-3. Résumé du code

 
Sélectionnez
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;

8. Styles de lignes

Créez un nouveau projet et ajoutez un gestionnaire OnPaint :

 
Sélectionnez
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 :

Image non disponible

8-A. Styles de jointure

Si vous voulez des coins ronds, vous pouvez spécifier :

 
Sélectionnez
image.JoinStyle := pjsRound;
Image non disponible

Vous pouvez mélanger les styles de jointures dans un même rectangle comme ceci :

 
Sélectionnez
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.

Image non disponible

8-B. Style de pinceau

Vous pouvez dessiner une ligne en pointillé comme cela :

 
Sélectionnez
    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 jointure.

Image non disponible Notez que l'extrémité de la ligne est arrondie.

8-C. Extrémités des lignes

Vous pouvez dessiner une polyligne avec des extrémités carrées comme cela :

 
Sélectionnez
    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);
Image non disponible

Vous pouvez dessiner une ligne qui est ouverte, c'est-à-dire que la fin de la ligne est arrondie à l'intérieur :

 
Sélectionnez
    image.DrawPolyLineAntialias([PointF(40,200),PointF(120,100),
                                 PointF(170,140),PointF(250,60)],
                                 c,10,False);
Image non disponible

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 :

 
Sélectionnez
    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);
Image non disponible

9. Splines

Ce chapitre traite du tracé de courbes à partir d'une suite de points.

Dans un nouveau projet, ajoutez un gestionnaire OnPaint avec :

 
Sélectionnez
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 :

 
Sélectionnez
    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 stoquer les points de la spline comme cela :

 
Sélectionnez
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 utiliser.

A l'exécution, l'application dessine deux splines, une ouverte à gauche et une fermée à droite.

Image non disponible

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 :

 
Sélectionnez
    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.

A l'exécution, vous devriez voir une courbe de Bézier en gras à l'intérieur du rectangle gauche.

Image non disponible

10. Écrire du texte

Vous pouvez dessiner un texte simple comme cela :

 
Sélectionnez
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.

Image non disponible

Il est possible de spécifier un alignement :

 
Sélectionnez
  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 à aligné sur la droite.

Image non disponible

Il est aussi facile de dessiner du texte tourné. Pour cela, utilisez TextOutAngle ou bien la propriété FontOrientation :

 
Sélectionnez
  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.

Image non disponible

Remarquez à présent où est l'origine du texte (le pixel ajouté).

10-A. Texte avec retour à la ligne

Il y a une version facile à utiliser de TextRect :

 
Sélectionnez
  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.

Image non disponible

10-B. Effets sur le texte

Vous pouvez dessiner un texte avec une ombre floue avec TextShadow de l'unité BGRAGradients :

 
Sélectionnez
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.

Image non disponible

Comme les autres fonctions, vous pouvez passer en paramètre un dégradé ou une texture pour remplir le texte. Voici un exemple :

 
Sélectionnez
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.

Image non disponible

11. Textures

Créez un nouveau projet et ajouter 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, ajouter un gestionnaire OnPaint et écrivez :

 
Sélectionnez
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 :

 
Sélectionnez
    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.

Image non disponible

11-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 :

 
Sélectionnez
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 :

Image non disponible

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 :

 
Sélectionnez
  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 :

 
Sélectionnez

  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 :

 
Sélectionnez
    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 :

Image non disponible

11-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 :

 
Sélectionnez
    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 :

 
Sélectionnez
    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;
Image non disponible

11-A-2. Fonction sinus

Nous pouvons appliquer la fonction sinus au valeurs du bruit pour générer des oscillations. Créons pour cela une procédure :

 
Sélectionnez
  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 :

 
Sélectionnez
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 :

Image non disponible

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 :

 
Sélectionnez
    colorOscillation := round(power((sin(p^.red*Pi/80)+1)/2,0.2)*256);

Nous avons alors quelque chose qui ressemble beaucoup plus à du marbre :

Image non disponible

Une texture de bois peut être réalisée avec des fonctions sinus également. La texture de bois contient 2 oscillations, une avec des couleur claires, et une autre avec des couleurs foncées. Alors nous devons appliquer une variation globale entre ces oscillations :

 
Sélectionnez
  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 :

Image non disponible

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 :

 
Sélectionnez
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 :

Image non disponible

11-B. Plaquage de textures

Regardons ce qu'il arrive si on dessine un polygone avec une texture en utilisant le placage par défaut :

 
Sélectionnez
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 un 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 :

Image non disponible

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 :

 
Sélectionnez
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 :

Image non disponible

Comme précédemment, l'image est simplement répétée et découpée à la façon d'un masque.

11-B-1. Plaquage linéaire

Le placage linéaire étire l'image linéairement le long des bords. Pour faire cela :

 
Sélectionnez
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. Des 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 :

Image non disponible

Afin d'avoir un antialiasing du polygone, il est possible dans ce cas d'utiliser FillQuadLinearMappingAntialias.

11-B-2. Plaquage avec perspective

Le placage avec perspective permet de définir pour chaque point sa profondeur.

 
Sélectionnez
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 :

Image non disponible

Avec ces techniques, il est possible de déformer une image et de dessiner des objets en 3D avec textures.

12. Dégradés et transformations

On peut dessiner un dégradé avec la fonction GradientFill :

 
Sélectionnez
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ée;
  • Le type de gradient;
  • Les points de contrôle du gradient;
  • Le mode de dessin.
Image non disponible

12-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 :

 
Sélectionnez
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 :

 
Sélectionnez
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.

Image non disponible

Nous pouvons ajouter une autre transformation comme cela :

 
Sélectionnez
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.

A présent, le centre du dégradé est tourbillonnant.

Image non disponible

12-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 :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

Image non disponible

Ajoutez des couleurs et modifiant la procédure ScanAt du dégradé multiplicateur :

 
Sélectionnez
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éfinie avec un cycle des positions x et y.

Enfin ajoutez une rotation :

 
Sélectionnez
  affine := TBGRAAffineScannerTransform.Create(grad);
  affine.Scale(6,4);
  affine.RotateDeg(-30);
  affine.Translate(ClientWidth/2, ClientHeight/2);
Image non disponible

Le dégradé résultant peut-être utilisé comme une texture.

13. É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 :

 
Sélectionnez
TForm1 = class(TForm) 
  ...
  phong: TPhongShading;

Quand la fenêtre est créée, on crée la classe :

 
Sélectionnez
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 le fenêtre est détruite :

 
Sélectionnez
procedure TForm1.FormDestroy(Sender: TObject);
begin
  phong.Free;
end;

Quand l'image est peinte, on ajoute un objet avec éclairage de Phong :

 
Sélectionnez
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 :

 
Sélectionnez
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 :

Image non disponible

13-A. Textures avec éclairage de Phong

La procédure suivante crée un carré de chocolat :

 
Sélectionnez
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 :

 
Sélectionnez
chocolate := CreateChocolateTexture(80,80);

Et quand la fenêtre est détruite :

 
Sélectionnez
chocolate.Free;

Avant phong.DrawSphere dans l'événement OnPaint, ajoutez cette ligne :

 
Sélectionnez
image.FillRect(0,0,80*7,80*4,chocolate,dmSet);

13-A-1. Code résultant

 
Sélectionnez
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.

A l'exécution, vous devriez voir une plaquette de chocolat appétissante avec une grosse cerise :

Image non disponible

13-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 :

 
Sélectionnez
  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 :

 
Sélectionnez
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;

A l'exécution, vous devriez voir une fenêtre avec un fond de pierre.

Image non disponible

13-B-1. Faire de l'eau

C'est presque la même procédure pour générer de l'eau :

 
Sélectionnez
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.

Image non disponible

13-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 :

 
Sélectionnez
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;
Image non disponible

Vous avez aimé ce tutoriel ? Alors partagez-le en cliquant sur les boutons suivants : Viadeo Twitter Facebook Share on Google+   

  

Les sources présentées sur cette page sont libres de droits et vous pouvez les utiliser à votre convenance. Par contre, la page de présentation constitue une œuvre intellectuelle protégée par les droits d'auteur. Copyright © 2011 Johann Elsass. Aucune reproduction, même partielle, ne peut être faite de ce site et de l'ensemble de son contenu : textes, documents, images, etc. sans l'autorisation expresse de l'auteur. Sinon vous encourez selon la loi jusqu'à trois ans de prison et jusqu'à 300 000 € de dommages et intérêts.