Comment réaliser un 'effet de loupe' ?

L'astuce consiste à utiliser la procédure CopyRect d'un Canvas.

procedure CopyRect(Dest: TRect; Canvas: TCanvas; Source: TRect);

Elle permet de copier dans le canevas une partie de l'image d'un autre canevas. Dest spécifie le rectangle du canevas où l'image source doit être copiée. Le paramètre Canvas spécifie le canevas contenant l'image source. Source spécifie le rectangle délimitant la partie du canevas source à copier. Si les paramètres Dest et Source ont les mêmes dimensions, l'image est juste copiée. Alors que s'ils sont de tailles différentes, l'image est redimensionnée. Cela permet donc d'agrandir ou de rétrécir tout ou partie d'une image.

Dans notre exemple, on va se baser sur l'écran. On va récupérer une partie de l'écran, centrée sur la souris. Pour plus de clarté, on va créer une procédure, avec pour paramètre la position de la souris.

procedure Loupe(x,y: Integer);

L'idéal serait d'appeler cette méthode dès que la souris bouge, ce qui est simple quand elle reste sur notre fiche. Mais, c'est un peu plus compliqué lorsqu'elle en sort. Dans notre exemple, on va utiliser un Timer, avec un faible Intervalle, soit 1. Et on appelle la procédure :

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Loupe(Mouse.CursorPos.x, Mouse.CursorPos.y);
end;

On peut maintenant se concentrer sur notre procédure. On va zoomer sur un carré, de côté 40 pixels et de centre la position de la souris, c'est-à-dire (x,y). On définit la zone par un TRect, appelé ici Cadre1 :

procedure Loupe(x,y: Integer);
var
  Cadre1: TRect;
begin
  // définition d'un carré de 40x40 pixels centré sur la position de la souris
  Cadre1.Top := y - 20 - Form1.Top;
  Cadre1.Left := x - 20 - Form1.Left;
  Cadre1.Right := x + 20 - Form1.Left;
  Cadre1.Bottom := y + 20 -Form1.Top;
end;

Vous aurez remarqué qu'il faut retrancher la position de la fiche à la position de Cadre1. Il ne faut pas l'oublier, car ce rectangle est défini par rapport à l'ÉCRAN (son coin supérieur gauche). Et, quand on l'affichera sur la fiche, les positions se feront par rapport au coin supérieur gauche de la FICHE. Cela provoquerait un décalage assez important.

On doit maintenant définir un second carré : celui que l'on affichera sur la fiche. Il doit donc être de dimension supérieure pour provoquer un agrandissement.

procedure Loupe(x,y: Integer);
var
  Cadre1, Cadre2: TRect;
begin
  // définition d'un carré de 40x40 pixels centré sur la position de la souris
  Cadre1.Top := y - 20 - Form1.Top;
  Cadre1.Left := x - 20 - Form1.Left;
  Cadre1.Right := x + 20 - Form1.Left;>
  Cadre1.Bottom := y + 20 -Form1.Top;

  // définition d'un carré de 100x100 pixels pour l'affichage
  Cadre2.Top:=10;
  Cadre2.Left:=10;
  Cadre2.Right:=110;
  Cadre2.Bottom:=110;
end;

Il nous reste maintenant à copier le Cadre1 vers le Cadre2 au moyen de la méthode CopyRect.

Form1.Canvas.CopyRect(Cadre2, Form1.Canvas, Cadre1);

Le programme est maintenant opérationnel. On peut l'améliorer, en mettant la possibilité de régler le zoom. On rajoute le paramètre Size dans notre procédure, qui déterminera la taille du rectangle à copier. Donc, plus le rectangle sera petit, plus le zoom sera puissant.

procedure Loupe(x, y, Size: Integer);
var
  Cadre1, Cadre2: TRect;
begin
  // définition d'un carré centré sur la position de la souris
  Cadre1.Top := y - Size - Form1.Top;
  Cadre1.Left := x - Size - Form1.Left;
  Cadre1.Right := x + Size - Form1.Left;
  Cadre1.Bottom := y + Size -Form1.Top;
  {...}
end;

On ajoute un TTrackBar sur la fiche, pour pouvoir régler le zoom. Je l'ai appelé TBar (c'est plus court ;-). On modifie l'événement OnTimer du Timer, en ajoutant le nouveau paramètre :

Loupe(Mouse.CursorPos.x, Mouse.CursorPos.y, TBar.Position);

On ajoute maintenant un TLabel pour afficher le grossissement :

Label1.Caption := IntToStr(100 * 100 div (TBar.Position * 2))+' %';

On multiplie d'abord par 100 pour avoir un pourcentage, sinon on aurait toujours 0, puisqu'on travaille avec des entiers (Delphi arrondirait la valeur). On a un deuxième 100, car c'est la taille de l'image qui est affichée (sur la fiche). On a presque fini notre programme. Si on veut enregistrer l'image agrandie, il serait préférable de l'afficher dans un TImage (que j'ai appelé Img). On a juste quelques modifications à effectuer. À la fin, vous devriez avoir un source, ressemblant à ça :

unit LoupeUnit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Timer1: TTimer;
    tbar: TTrackBar;
    img: TImage;
    Label1: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure tbarChange(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  close;
end;

procedure Loupe(x, y, Size: Integer);
var
  Cadre1, Cadre2: TRect;
begin
  // définition d'un carré centré sur la position de la souris
  Cadre1.Top := y - Size - Form1.Top;
  Cadre1.Left := x - Size - Form1.Left;
  Cadre1.Right := x + Size - Form1.Left;
  Cadre1.Bottom := y + Size -Form1.Top;

  // On récupère la taille de l'image pour afficher dedans l'image agrandie.
  Cadre2.Top := 0;
  Cadre2.Left := 0;
  Cadre2.Right := Form1.Img.Width;
  Cadre2.Bottom := Form1.img.Height;

  Form1.Img.Canvas.CopyRect(Cadre2, Form1.Canvas, Cadre1);
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  Loupe(Mouse.CursorPos.x, Mouse.CursorPos.y, TBar.Position);
end;

procedure TForm1.tbarChange(Sender: TObject);
begin
  Label1.Caption := IntToStr(100 * 100 div (TBar.Position * 2))+' %';
end;
end.

Nous voici à la fin de ce tutoriel. Vous pouvez adapter l'exemple à vos propres besoins. Vous devez être capable de réaliser un logiciel de capture d'écran. Vous pouvez télécharger le programme d'exemple ici. J'ai réalisé ce cours grâce à un exemple de Lionel Rouvarel. N'hésitez surtout pas à me dire ce que vous pensez, ou si vous avez des problèmes.
Tout commentaire, suggestion, remarque ou question sont les bienvenus.
Si vous avez le temps, visitez mon site Le Temple de la Programmation !

Un mot d'encouragement ou un compliment fait toujours plaisir.

LLB/DeuSSuM