Discussion :

[yupyupxav]

Bonjour à tous,

Dans le cadre d'un projet que j'ai mis depuis trop longtemps de côté, je voudrais afficher une image, sélectionner une partie de celle-ci, puis recopier la sélection dans un fichier.

Pour ce faire, j'ai une fiche avec un TImageViewer qui a TSelection comme enfant.

En appuyant sur le bouton, comme me l'a suggéré SergioMaster il y a un bon bout de temps déjà, j'effectue ce code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
 
procedure TForm4.Button1Click(Sender: TObject);
var
 b: tbitmap;
begin
 b:=Selection1.MakeScreenshot;
 b.SaveToFile('d:\test.jpg');
 b.Free;
end;

Le résultat obtenu n'est pas bon, car mis à part le dessin de la TSelection, l'image qui devrait être copiée reste noire. J'ai essayé plusieurs formats de fichier.


Je pense que le contrôle TSelection n'est finalement que transparent, et que de ce fait, il ne m'enregistre pas l'image. Il y a il moyen de copier dans un Bitmap cette sélection de manière élégante?

Merci de vos infos.
Xav

[SergioMaster]

Bonjour,

j'ai déjà eu le même soucis et c'est "juste" un problème de fond d'image. Je me souviens que dans une des discussions sur ce forum j'avais donné ma solution je t'engage à lire la discussion entière bien sûr . Il est dommage que krzysiu n'ai pas donné suite à son idée de tutoriel, mais je comprend le temps est une denrée rare

Depuis j'ai fait un truc plus poussé, si l'explication ne suffit pas je pourrai toujours ressortir les sources pour en extraire "la substantifique moelle"

[yupyupxav]

Salut SergioMaster,

Dans mon cas, étant donné que le Tbitmap est crée par MakeScreenShot et que c'est ce même MAkeScreenShot qui dessine sur TBitmap, je ne peux appeler clear qu'après cette fonction, ce qui aura comme résultat d'effacer mon image, non?

Merci

[SergioMaster]

Bonjour,

Ce n'est pas le bitmap qu'il faut initialiser mais la zone de capture soit le fond , et ce une seule fois.
(au moment où j'écris ces lignes je n'ai pas XE sous la main, je reviendrai faire un tour dans une heure ou deux)
[Edit]
Oublions les c.....s que j'ai écrit c'est vrai mais l'explication est foireuse
après quelques tests rapides, j'ai obtenu un résultat "avec fond" en utilisant le TSelection comme parent d'un Rectangle (dont on peut modifier la couleur de fond Fill), et d'un ImageViewer
l'inconvénient c'est que la sélection est plus ou moins capricieuse .

Après nettoyage de mon disque j'ai pu retrouver le source auquel je faisait allusion dans le post #2
L'objectif du programme était de pouvoir retailler/agrandir/réduire une image dans cadre de taille fixe
Pour ce faire j'ai en fait utiliser (dans l'ordre de filiation)
un TSelection Selection2
- Un Trectangle Rectangle1 (mon gabarit) , ce dernier à une couleur créme (#FFF7FCCB pour être précis)
- un TSelection Selection2 (qui va retailler l'image)
. un TImage
après c'est une question de traitement

je procède de la manière suivante

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
 
var Bmp : TBitmap;
    RectColor : TColor;
    vBitMapData : TBitmapData;
    vPixelColor : TAlphaColor;
...
begin
...
RectColor:=Rectangle1.Fill.Color;
try
// Préparation image
 // cache les poignées et les pointillés de la sélection
 Selection1.HideSelection:=true;
 DeflateSelection;  // une fonction de mon cru est nécessaire
                           // permet également de gérer Selection2 qui va faire la capture
 
 // Récupération de la couleur de fond
 if image1.Bitmap.Map(TMapAccess.Read, vBitMapData) then // verrouillage image et obtention pixels
     begin
       vPixelColor := vBitmapData.GetPixel(1,1);  // couleur du pixel
       image1.Bitmap.Unmap(vBitMapData);      // déverrouillage the bitmap
       Rectangle1.Fill.Color:=vPixelColor;          // remplissage rectangle 
     end
 else Rectangle1.Fill.Color:=TAlphaColorRec.White; // pas réussi ? fond blanc par défaut
 
// Sauvegarde image
 bmp := Selection2.MakeScreenshot;
 try
    Bmp.SaveToFile(nomfichier);
 finally
    bmp.free;
 end;
finally
  // réinitialisation zones
 Rectangle1.Fill.Color:=RectColor; // ma couleur "crème" de départ
 InflateSelection;                         //  fonction de mon cru : retour "à la normale" de Selection1
 Selection1.HideSelection:=False; // 
end;
...
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
procedure TForm.DeflateSelection;
{$REGION 'Documentation'}
{*------------------------------------------------------------------------------
  procedure DeflateSelection
  Mémorise la taille et position initiale
  et se recadre sur le rectangle voulu
------------------------------------------------------------------------------*}
{$ENDREGION}
begin
 // Mémorise position et taille
 selectionpositionx:=selection2.position.x;
 selectionpositiony:=selection2.position.y;
 SelectionWidth:=Selection2.Width;
 SelectionHeight:=Selection2.Height;
 RectanglePositionX:=Rectangle1.position.x;
 RectanglePositionY:=Rectangle1.position.Y;
 SelectionImageX:=Selection1.Position.X;
 SelectionImageY:=Selection1.Position.Y;
 // Centre sur Rectangle
 Selection2.Position.x:=Selection2.Position.x+RectanglePositionX;
 Selection2.Position.Y:=Selection2.Position.Y+RectanglePositionY;
 Selection2.Width:=Rectangle1.Width;
 Selection2.Height:=Rectangle1.Height;
 Selection1.Position.X:=SelectionImageX-RectanglePositionX;
 Selection1.Position.Y:=SelectionImageY-RectanglePositionY;
 Rectangle1.Position.X:=0;
 Rectangle1.Position.Y:=0;
end;

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TMainForm.InflateSelection;
{$REGION 'Documentation'}
{*------------------------------------------------------------------------------
  Inflate Selection
  Remet la Selection a sa taille d'origine
------------------------------------------------------------------------------*}
{$ENDREGION}
begin
 Selection2.Position.X:=SelectionPositionX;
 Selection2.Position.Y:=SelectionPositionY;
 Selection2.Width:=SelectionWidth;
 Selection2.Height:=SelectionHeight;
 Rectangle1.Position.X:=RectanglePositionX;
 Rectangle1.Position.Y:=RectanglePositionY;
 Selection1.Position.X:=SelectionImageX;
 Selection1.Position.Y:=SelectionImageY;
end;

En espérant que cela te mettra sur la piste, ce programme écrit avec XE4 est utilisé chaque saison (saison de la mode) pour enregistrer des vignettes photos des articles vendus.
Il est certainement "amélorable" mais puisqu'il fonctionne ......
je crois que j'en parle dans d'autres posts mais pas sur cette partie du traitement en tout cas c'est ce programme qui m'a amené à écrire le tutoriel sur les styles FireMonkey

[Andnotor]

Je ne connais pas FMX (je ne l'ai même pas installé) mais une image noire est typique de la copie d'une image 24 bits dans une autre 32 bits : le canal alpha est à 0.
N'y a-t-il pas un réglage à ce niveau, un PixelFormat ?

[SergioMaster]

Bonjour,

Je ne connais pas FMX (je ne l'ai même pas installé) mais une image noire est typique de la copie d'une image 24 bits dans une autre 32 bits : le canal alpha est à 0.
N'y a-t-il pas un réglage à ce niveau, un PixelFormat ?

Piste intéressante, j'ai donc vérifié
le PixelFormat est (tel que défini avec FMX) BGRA soit avec la valeur 4, cette propriété est en lecture seule je vais chercher un moyen de la modifier.
@andnotor voici les valeurs possibles avec FMX

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
TPixelFormat = (None, RGB, RGBA, BGR, BGRA, RGBA16, BGR_565, BGRA4, BGR4, BGR5_A1, BGR5, BGR10_A2, RGB10_A2, L, LA,
    LA4, L16, A, R16F, RG16F, RGBA16F, R32F, RG32F, RGBA32F);
const
  PixelFormatBytes: array[TPixelFormat] of Integer = ({ None } 0, { RGB } 4, { RGBA } 4, { BGR } 4, { BGRA } 4,
    { RGBA16 } 8, { BGR_565 } 2, { BGRA4 } 2, { BGR4 } 2, { BGR5_A1 } 2, { BGR5 } 2, { BGR10_A2 } 4, { RGB10_A2 } 4,
    { L } 1, { LA } 2, { LA4 } 1, { L16 } 2, { A } 1, { R16F } 2, { RG16F } 4, { RGBA16F } 8, { R32F } 4, { RG32F } 8,
    { RGBA32F } 16);

je crains que cela ne soit très compliqué ! une recherche google : "Delphi FMX Bitmap change pixelformat" ne m'a pas rassuré, on se demande pourquoi tant de Pixel Format sont proposé alors que Delphi ne semble travailler qu'avec un seul (du moins après chargement de l'image)
une autre solution consistant à travailler sur les CODECs semble plus intéressante mais si nébuleuse encore pour moi que j'en resterai à mes manipulations

[Andnotor]

Je vois qu'il y a des fonctions de conversion, par exemple AlphaColorToScanline.

[SergioMaster]

Oui mais tu resteras malgré tout en BGRA 32 bits pour le format de sortie

[Andnotor]

Pas en jpeg. Il devrait y avoir multiplication des couleurs par le canal alpha par rapport à un fond blanc (selon la formule : CouleurPremierPlan *Alpha + CouleurFond *(1 -Alpha)). L'information est toujours stockée sur 32 bits mais avec une profondeur de 24.

Mais à toi de voir

[yupyupxav]

Salut SergioMaster,

je comprends bien la philosophie de ton examples avec les deux tselection, mais il y a quelque chose qui m'échape.
Quels doivent être les alignements des différents contrôles. Si le Selection2 est parent du rectangle, de l'image et de selection1, Je suppose que celui-ci a une taille immuable et correspond à la place que je veux bien lui allouer sur ma fiche (AlignClient sur un Panel par exemple)
Je ne saisis pas bien quels doivent être les alignements des autres contrôles? Qu'en est il des propriétés ClipParent, ClipChildren?

Désolé mais je n'ai pas bien saisi l'astuce.

[SergioMaster]

Bonjour,

le seul alignement (alclient) concerne Image1 les autres sont à none.
Pour ce qui est des ClipParent/ClipChildren pour tous les composants cité leurs valeurs sont à false sauf pour le rectangle qui lui a ClipChildren à true.

Te justifier ces valeurs, j'en serais incapable, le programme date de 3 ans ce dont je me souviens le plus c'est de la galère pour obtenir le bon résultat Comme, en plus, j'ai voulu y mettre une animation (une sorte de diaphragme qui se ferme avec un clic sonore) pour le "fun" il y a dans cette partie d'écran pas mal de layouts qui s'ajoutent (du coup pas facile de sortir un schéma précis)

@Andnotor MakeScreenShot crée directement le bitmap, donc on ne peut remplir le canvas de ce dernier avant la capture

en fait, en réfléchissant à tout ça, en gardant la même "philosophie" voici un moyen simple à partir du code de départ (ici avoir le contenu de Selection1 sur fond uni bleu), quelques try finally seraient peut être mieux pour plus de "sécurité"

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
procedure TForm6.Button1Click(Sender: TObject);
var
 b: tbitmap;
 r : TRectangle;
 S : TSides;
begin
 r:=TRectangle.Create(Selection1);  // créer un rectangle
 r.Parent:=Selection1;                    // bien indiquer le contrôle parent 
 r.Fill.Color:=TAlphaColors.Blue;      // remplissage du rectangle  (là on peut beaucoup jouer : dégradé, image etc...)
 r.Sides:=[];                                 // oter les bordures
 r.Align:=TAlignLayout.alclient;        // remplir toute la sélection 
 r.SendToBack;                             // envoyer en arrière plan
 b:=Selection1.MakeScreenshot;
 r.Free;                                        // libérer
 b.SaveToFile('f:\test.jpg');
 b.Free;
end;

Serait-ce l'objet possible d'une FAQ FMX , à votre avis ?

[yupyupxav]

Salut SergioMaster,

Ton code fonctionne bien dans l'espèce. Il permet de redimensionner l'image à une taille prédéfinie (mais qui ne sera jamais plus grande que la taille du Tselection).
J'ai de ce fait à la va-vite (le code n'est pas élégant) codé un deuxième Tselection avec image1 comme parent qui me permet de rogner l'image après l'avoir redimensionnée.
J'ai codé l'enregistrement de la seconde image dans le même évènement buttonclick.
Voilà le résultat:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
 
procedure TForm4.Button1Click(Sender: TObject);
var
 b,c: tbitmap;
 r : TRectangle;
 S : TSides;
 t:Trect;
begin
 Selection2.HideSelection:=true;
 r:=TRectangle.Create(Selection1);  // créer un rectangle
 r.Parent:=Selection1;                    // bien indiquer le contrôle parent
 r.Fill.Color:=TAlphaColors.Blue;      // remplissage du rectangle  (là on peut beaucoup jouer : dégradé, image etc...)
 r.Sides:=[];                                 // oter les bordures
 r.Align:=TAlignLayout.alclient;        // remplir toute la sélection
 r.SendToBack;                             // envoyer en arrière plan
 b:=Selection1.MakeScreenshot;
 r.Free;                                        // libérer
 b.SaveToFile('d:\test.jpg');
 t.Left:=Trunc(selection2.Position.X);   // On crée un Trect de la taille de Selection2
 t.Top:=Trunc(selection2.Position.Y);   // Dommage Selection2 a un membre trectf mais
 t.Width:=Trunc(selection2.Width);     // copyFromBitmap a besoin de Trect. 
 t.Height:=Trunc(selection2.Height);    // Il y a surement un moyen plus élégant de créer ce trect
 c:=TBitmap.Create(t.Width,t.Height); // initialisation du bitmap rogné
 c.Clear(talphacolors.White);             // probablement optionnel
 c.CopyFromBitmap(b,t,0,0);             // la fonction de copie.
 c.SaveToFile('d:\test2.jpg');
 c.Free;
 b.Free;
 Selection2.HideSelection:=false;
end;

Voilà la conversation est pour moi résolue, et je pense effectivement que ton code ferait bien dans la FAQ FMX.

Merci pour votre investissement à tous.
Xavier