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 Dest et Source
ont les mêmes dimensions, l'image est juste copiée. Aors
que s'ils sont de taille différente, l'image est redimensionée.
Cela permet donc d'agrandir ou de retrécir une image (ou
une partie d'elle). |
. |
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 utiliser
un Timer, avec un faible Interval, 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'ECRAN (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 aggrandissement. |
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. Ca fait quand
même mieux ! |
|
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 aggrandie,
il serait préférable de l'afficher dans un TImage (que j'ai
appelé Img). On a juste quelques modifications à effectuer.
A 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 aggrandie. |
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 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. Un
mot d'encouragement ou un compliment fait toujours plaisir.
|