[Lazarus] Utilisation Tcanvas, Timage [Résolu]

[ApproxDev]

Bonjour,

Je travaille sur un stretch "manuel". Mon code fonctionne mais j'aimerais obtenir le même résultat sans passer par les TImage dans les calculs intermédiaires.
Sur la vignette, on distingue à droite le résultat obtenu... et à gauche les objets initiaux.
Le but de l'opération ici est d'élargir Image1 en longueur sans en élargir les "bords" de 1 pixel. Si on utilise le stretch normal, les bords vont rapidement passer à 2, 3 pixels provoquant un effet peu esthétique. Ici je regarde simplement la faisabilité sur un stretch horizontal, l"opération étant reconduite pour la partie verticale. Je n'ai peut-être pas besoin de préciser que les fonctions associées aux TRect et autres TCanvas me sont plutôt étrangères... Si quelqu'un a une doc exhaustive la-dessus avec les "bonnes" bibliothèques qui s'y attachent (y compris compatibles Linux), je suis preneur.

Le code est celui-ci :

Code :

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
procedure TForm1.BitBtn1Click(Sender: TObject);
var
 
  {Image 1 -> lRect de 0 à Image1.Width div 2
             rRect de Image1.Width div 2 à Image1.Width;
             mRect de Image1.Width div 2 à (Image1.Width div 2) +1}
  mRect, rRect, lRect : TRect;
 {Image 2 -> dRect : Rectangle de destination
             lPos, rPos : Positionnement des rect. copiés}
  dRect : TRect;
  lPos, rPos, i : Integer;
 
begin
 
  with Image1.canvas do begin
    lRect:=Rect(0, 0,Image1.Width div 2,Image1.Height);
    CopyRect(lRect, Image1.Canvas, lRect);
    rRect := Rect(Image1.Width div 2,0,Image1.Width,Image1.Height);
    CopyRect(rRect, Image1.Canvas, rRect);
    mRect:=Rect(Image1.Width div 2,0,(Image1.Width div 2) +1,Image1.Height);
    CopyRect(mRect, Image1.Canvas, mRect);
  end;
 
  with Image2.canvas do begin
    {détermination des bornes des zones dans Image2}
    rPos := Image2.Width - (Image1.Width div 2);
    lPos := Image1.Width div 2;
 
    dRect := Rect(0,0,Image1.Width div 2,Image1.Height);
    CopyRect(dRect, Image1.Canvas,lRect);
 
    for i := lPos  to rPos -1  do begin
      dRect := Rect(i, 0, i+1, Image1.Height);
      CopyRect(dRect, Image1.Canvas, mRect);
    end;
 
    dRect := Rect(rPos,0,Image2.Width,Image1.Height);
    CopyRect(dRect, Image1.Canvas, rRect);
  end;
end;

Le problème c'est que je voudrais me débarasser des TImage pour ne garder que des TCanvas et des TRect. Je garderais Image1 et Image2 comme point de départ et d'arrivée... Je me suis dit dans un premier temps que c'était simple en créant srcCanvas pour arriver à dstCanvas... Et là, je bugge : il y a toujours quelque chose qui n'est pas défini ou qui n'est pas du bon type.

Un petit coup de main SVP...
Merci. A+

[ApproxDev]

J'ai un code fonctionnel mais j'utilise un Tcanvas "libre" sans handle... Je croyais que c'était impossible.

Code :

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
41
42
43
44
45
46
47
48
49
50
51
procedure TForm1.aTraiter(srcBitMap, dstBitMap : TBitmap; aHeight, aWidth : Integer);
var
  {srcBitMap -> lRect de 0 à srcBitMap.Width div 2
                rRect de srcBitMap.Width div 2 à srcBitMap.Width;
                mRect de srcBitMap.Width div 2 à (srcBitMap.Width div 2) +1}
   mRect, rRect, lRect : TRect;
  {dstBitMap-> dRect : Rectangle de destination
               lPos, rPos : Positionnement des rect. copiés}
   dRect : TRect;
   lPos, rPos, i : Integer;
   srcCanvas : TCanvas;
begin
  if (srcBitMap.Width < aWidth) then begin
 
  //srcCanvas := TCanvas.Create; Non nécessaire + Handle ???
    srcCanvas := srcBitMap.Canvas;
 
    lRect := Rect(0, 0, srcCanvas.Width div 2, srcCanvas.Height);
    srcCanvas.CopyRect(lRect, srcCanvas, lRect);
    rRect := Rect(srcCanvas.Width div 2, 0, srcCanvas.Width, srcCanvas.Height);
    srcCanvas.CopyRect(rRect, srcCanvas, rRect);
    mRect := Rect(srcCanvas.Width div 2, 0,(srcCanvas.Width div 2) +1, srcCanvas.Height);
    srcCanvas.CopyRect(mRect, srcCanvas, mRect);
 
    dstBitMap.Width  := aWidth;
    dstbitMap.Height := aHeight;
 
    with dstBitMap.Canvas do begin
      {détermination des bornes des zones dans dstBitMap}
      rPos := dstBitMap.Width - (srcCanvas.Width div 2);
      lPos := srcCanvas.Width div 2;
 
      dRect := Rect(0, 0, srcCanvas.Width div 2, srcCanvas.Height);
      CopyRect(dRect, srcCanvas, lRect);
 
      for i := lPos  to rPos -1  do begin
        dRect := Rect(i, 0, i+1, srcCanvas.Height);
        CopyRect(dRect, srcCanvas, mRect);
      end;
 
      dRect := Rect(rPos, 0, dstBitMap.Width, srcCanvas.Height);
      CopyRect(dRect, srcCanvas, rRect);
    end;
 
  end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  aTraiter(Image1.Picture.Bitmap, Image2.Picture.Bitmap,Image2.height, Image2.Width);
end;

Cela à l'air à peu près fonctionnel. Maintenant il faut arriver au mode 9 images pris comme référence... Donc définir une limite gauche et une limite droite (pour l'élargissement horizontal), une limite haute et une limite basse pour la partie verticale et faire jouer le stretch sur cette partie.

[M.Dlb]

Je dis peut-être n'importe quoi, mais je pensais à une autre approche. Pourquoi ne pas laisser l'image (ne contenant pas les contours, c'est à dire ne représentant que le fond) se strechant normalement, puis dessiner manuellement les bords ? Si c'est 4 traits marron, ca doit pouvoir se faire facilement non ?

[ApproxDev]

Oui, oui... merci pour ta réflexion... Je viens de comprendre comment marche le mode 9 images de Windev qui est le point de départ... je me suis concentré sur le code sans m'imposer l'étape d'analyse nécessaire.
Ma faiblesse dans le traitement des images et la difficulté à trouver de la Doc spécifique à Lazarus ont pris le pas sur ce point qui est "quand même un peu" essentiel.

Donc merci beaucoup ! Je n'ai plus qu'a recommencer en espérant que la définition du Canvas "libre" est légale.

[ApproxDev]

Bon, je crois que c'est opérationnel :

Code :

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
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
procedure TForm1.aTraiterWH(srcBitMap, dstBitMap : TBitmap; aHeight,
          aWidth : Integer; TraitG, TraitD, TraitH, TraitB : integer);
{Les TraitX sont comptés à partir des coins}
var
  {srcBitMap}
   cRect : TRect;                                 //Strechés W et H
   ghRect, dhRect, dbrect, gbRect : TRect;        //Non strechés
   mhRect, mbRect : Trect;                        //Strechés W
   gmRect, dmRect : Trect;                        //Strechés H
 
  {dstBitMap}                                     //dRect : Rect de destination
   dRect : TRect;
   dTraitG, dTraitD, dTraitH, dTraitB : Integer;  //Position des traits
 
   {Variables Tmp}
   srcCanvas : TCanvas;
   BitMapTmp : TBitmap;
begin
  try
      BitMapTmp := TBitmap.Create;
      {L'image d'origine}
      srcCanvas := srcBitMap.Canvas;
      {Les coins}
      ghRect := Rect(0, 0, TraitG, TraitH);
      srcCanvas.CopyRect(ghRect, srcCanvas, ghRect);
 
      dhRect := Rect(srcCanvas.Width -TraitD, 0, srcCanvas.Width, TraitH);
      srcCanvas.CopyRect(dhRect, srcCanvas, dhRect);
 
      dbRect := Rect(srcCanvas.Width -TraitD,srcCanvas.Height-TraitB, srcCanvas.Width, srcCanvas.Height);
      srcCanvas.CopyRect(dbRect, srcCanvas, dbRect);
      gbRect := Rect(0, srcCanvas.Height-TraitB, TraitG, srcCanvas.Height);
      srcCanvas.CopyRect(gbRect, srcCanvas, gbRect);
      {Les bords}
      mhRect := Rect(TraitG, 0, srcCanvas.Width -TraitD, TraitH);
      srcCanvas.CopyRect(mhRect, srcCanvas, mHRect);
      dmRect := Rect(srcCanvas.Width -TraitD, TraitH, srcCanvas.Width, srcCanvas.Height-TraitB);
      srcCanvas.CopyRect(mhRect, srcCanvas, mHRect);
      mbRect := Rect(TraitG, srcCanvas.Height-TraitB, srcCanvas.Width -TraitD, srcCanvas.Height);
      srcCanvas.CopyRect(mhRect, srcCanvas, mHRect);
      gmRect := Rect(0, TraitH, TraitG, srcCanvas.Height-TraitB);
      srcCanvas.CopyRect(gmRect, srcCanvas, gmRect);
      {Le centre}
      cRect := Rect(TraitG, TraitH, srcCanvas.Width -TraitD, srcCanvas.Height-TraitB);
      srcCanvas.CopyRect(cRect, srcCanvas, cRect);
      {-}
 
     {Caractéristiques de l'image temporaire de destination}
      BitMapTmp.Width  := aWidth;
      BitMapTmp.Height := aHeight;
      dTraitG := TraitG;
      dTraitH := TraitH;
      dTraitD := aWidth - TraitD;
      dTraitB := aHeight - TraitB;
 
      {Construction de l'image temporaire}
      with BitMapTmp.Canvas do begin
        dRect := Rect(0, 0, dTraitG, dTraitH);
        CopyRect(dRect, srcCanvas, ghRect);
        dRect := Rect(dTraitG, 0, DTraitd, dTraitH);
        CopyRect(dRect, srcCanvas, mhRect);
        dRect := Rect(dTraitD, 0, aWidth, dTraitH);
        CopyRect(dRect, srcCanvas, dhRect);
        dRect := Rect(dTraitD, dTraitH, aWidth, dTraitB);
        CopyRect(dRect, srcCanvas, dmRect);
        dRect := Rect(dTraitD, dTraitB, aWidth, aHeight);
        CopyRect(dRect, srcCanvas, dbRect);
        dRect := Rect(dTraitG, dTraitB, dTraitD, aHeight);
        CopyRect(dRect, srcCanvas, mbRect);
        dRect := Rect(0, dTraitB, dTraitG, aHeight);
        CopyRect(dRect, srcCanvas, gbRect);
        dRect := Rect(0, dTraitH, dTraitG, dTraitB);
        CopyRect(dRect, srcCanvas, gmRect);
        dRect := Rect(dTraitG, dTraitH, dTraitD, dTraitB);
        CopyRect(dRect, srcCanvas, cRect);
      end;
      dstBitMap.assign(BitMapTmp);
  finally
    BitMapTmp.Free;
  end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
begin
  aTraiterWH(Image1.Picture.Bitmap, Image2.Picture.Bitmap, Image2.Height, Image2.Width, 4, 4, 4, 4);
end;

La méthode est intégrable dans le code du TimagesBouton de Jon Shannow (voir la discussion) et dans mon ébauche également ... à la place du StrechDraw standard.

[Jon Shannow]

re-Bonjour ApproxDev,

Il y a un truc que je n'ai pas compris dans ton code. Ou plutôt dont je ne vois pas l'intérêt.

Code :

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
srcCanvas := srcBitMap.Canvas;
      {Les coins}
      ghRect := Rect(0, 0, TraitG, TraitH);
      srcCanvas.CopyRect(ghRect, srcCanvas, ghRect);
 
      dhRect := Rect(srcCanvas.Width -TraitD, 0, srcCanvas.Width, TraitH);
      srcCanvas.CopyRect(dhRect, srcCanvas, dhRect);
 
      dbRect := Rect(srcCanvas.Width -TraitD,srcCanvas.Height-TraitB, srcCanvas.Width, srcCanvas.Height);
      srcCanvas.CopyRect(dbRect, srcCanvas, dbRect);
      gbRect := Rect(0, srcCanvas.Height-TraitB, TraitG, srcCanvas.Height);
      srcCanvas.CopyRect(gbRect, srcCanvas, gbRect);
      {Les bords}
      mhRect := Rect(TraitG, 0, srcCanvas.Width -TraitD, TraitH);
      srcCanvas.CopyRect(mhRect, srcCanvas, mHRect);
      dmRect := Rect(srcCanvas.Width -TraitD, TraitH, srcCanvas.Width, srcCanvas.Height-TraitB);
      srcCanvas.CopyRect(mhRect, srcCanvas, mHRect);
      mbRect := Rect(TraitG, srcCanvas.Height-TraitB, srcCanvas.Width -TraitD, srcCanvas.Height);
      srcCanvas.CopyRect(mhRect, srcCanvas, mHRect);
      gmRect := Rect(0, TraitH, TraitG, srcCanvas.Height-TraitB);
      srcCanvas.CopyRect(gmRect, srcCanvas, gmRect);
      {Le centre}
      cRect := Rect(TraitG, TraitH, srcCanvas.Width -TraitD, srcCanvas.Height-TraitB);
      srcCanvas.CopyRect(cRect, srcCanvas, cRect);
      {-}

Dans cette partie, les copyRect me semble inutile. En effet tu copies le même rectangle dans le même canvas. Ou alors, j'ai loupé quelque chose...

Sinon pour le reste ça a l'air d'être correct. J'ai pas encore implanté le code dans le ImagesBouton, mais je pense que je vais le faire, avec une possibilité de laisser l'image telle qu'elle.

Je remets les sources une fois cela fait.

JS

[ApproxDev]

Bonjour,

Envoyé par Jon Shannow

re-Bonjour ApproxDev,
Dans cette partie, les copyRect me semble inutile. En effet tu copies le même rectangle dans le même canvas. Ou alors, j'ai loupé quelque chose...

Initialement (et pour mon propre code), il y a avait 2 Canvas : srcCanvas et dstCanvas.
A+