Aide pour ce qui ressemble à un bug dans mon programme svp ...

Bonjour,
Voici mon problème je cherche à réaliser une fonction qui récupere une image TBitmap la découpe en 16 zones égales et retourne un tableau de 16 images de même taille que l'original et représentant des portions agrandies de l'image d'origine.
Voici ma fonction :

type
  TZonesCar = array[1..16] of TBitmap;

function TAnalysCar.DecoupeCar(car : TBitmap) : TZonesCar;// agrandit l'image
// 4 fois puis la découpe en 4col et 4 lignes
var zones :TZonesCar;
    gdImg : TBitmap;
    i,x,y,l,h : Integer;
begin
gdImg:=TBitmap.Create;
gdImg.FreeImage;
if not(car.Width mod 2 = 0)
   then gdImg.Width:=car.Width+1
   else gdImg.Width:=car.Width;
if not(car.Height mod 2 = 0)
   then gdImg.Height:=car.Height+1
   else gdImg.Height:=car.Height;
gdImg.FreeImage;
gdImg.Width:= gdImg.Width * 4;
gdImg.Height:= gdImg.Height * 4;
l:=gdImg.Width div 4;
h:=gdImg.Height div 4;
// ici agrandi image (stretch) merci delphiprog
gdImg.Canvas.StretchDraw(gdImg.Canvas.ClipRect, car);
for i:=0 to 15  do begin
  x:=(i mod 4)*l;                     <=== ici l vaut 22
  y:=(i div 4)*h;                      <=== ici h vaut 32
  zones[i]:=TBitmap.Create;    <=== ERREUR ICI : je suppose ...
  zones[i].Height:=h;               <=== après l'appel de TBitmap.Create, h change de valeur (11032976)
  zones[i].Width:=l;
  bitblt (zones[i].Canvas.Handle,0, 0, l, h, gdImg.Canvas.Handle, x, y, srccopy);
end;

Ca ressemble à un débordement de mon tableau zones je suppose mais je ne comprend pas où je me trompe. Merci d'avance de m'aiguiller dans la bonne direction :)

soit tu fait :

TZonesCar = array[0..15] of TBitmap;

sinon tu fait :

for i := 0 to 15  do begin
  x:=(i mod 4)*l;
  y:=(i div 4)*h;
  zones[i+1]:=TBitmap.Create;
  zones[i+1].Height:=h;           
  zones[i+1].Width:=l;
  bitblt (zones[i+1].Canvas.Handle,0, 0, l, h, gdImg.Canvas.Handle, x, y, srccopy);
end;

---

Croc (click me)

Hello,

Oui, tu déclares un array[1..16] of TBitmap, mais dans ta fonction tu fais une boucle i := 0 to 15...

De plus, tu libères plusieurs fois gdImg, ça coince.

A mon avois, tu peux simplifier :
if not(car.Width mod 2 = 0)
   then gdImg.Width:=car.Width+1
   else gdImg.Width:=car.Width;
if not(car.Height mod 2 = 0)
   then gdImg.Height:=car.Height+1
   else gdImg.Height:=car.Height;
gdImg.Width:= gdImg.Width * 4;
gdImg.Height:= gdImg.Height * 4;

ainsi :
gdImg.Width := (car.Width + car.Width mod 2) * 4;
gdImg.Height := (car.Height + car.Height mod 2) * 4;


Voici pour finir le code retouché, j'ai testé, ça fonctionne aux petits oignons :

type
  TZonesCar = array[1..16] of TBitmap;

var
  ZonesCar: TZonesCar;

procedure FreeZonesCar;
var i: Integer;
begin
  for i := 1 to 16 do
    if Assigned(ZonesCar[i]) then
      ZonesCar[i].Free;
end;

function DecoupeCar(car : TBitmap) : TZonesCar;
var gdImg : TBitmap;
    i,x,y,l,h : Integer;
begin
  gdImg:=TBitmap.Create;
  gdImg.Width := (car.Width + car.Width mod 2) * 4;
  gdImg.Height := (car.Height + car.Height mod 2) * 4;
  l:=gdImg.Width div 4;
  h:=gdImg.Height div 4;
  gdImg.Canvas.StretchDraw(gdImg.Canvas.ClipRect, car);
  for i:=1 to 16  do
  begin
    x:=(i mod 4)*l;
    y:=(i div 4)*h;
    Result[i] := TBitmap.Create;
    Result[i].Height:=h;
    Result[i].Width:=l;
    bitblt (Result[i].Canvas.Handle,0, 0, l, h, gdImg.Canvas.Handle, x, y, srccopy);
  end;
  gdImg.Free;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin  // test
  ZonesCar := DecoupeCar(Image1.Picture.Bitmap);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  FreeZonesCar; // libérer les TImages du tableau
end;

Et n'oublie pas de libérer ton tableau de Bitmaps quand tu n'en as plus besoin (avant de fermer l'appli par exemple) avec la procedure FreeZonesCar.

Tout ça m'a épuisé, je vais me coucher...

Bonne nuit everybody,

japee

Salut f0xi,

J'ai décidément encore un train de retard...

Mais bon, le sujet m'intéressait, je m'y suis absorbé, quoi...

A +

Merci à tous pour vos réponses complètes et rapides,

Japee j'ai testé tes modifs, c'est exactement ce que j'espérais.

f0xie je n'ai pas encore eu le temps de tester ta réponse qui semble intéressante, je chercherais à optimiser ensuite donc tes conseils m'intéresse ;)
Si j'ai bien compris je remplace :
      - les x / 2 par x shl 2 ?
      - l'utilisation de bitblp par canvas.copyrect ?
      - et le tableau de 16 cases par un tableau à 2 dimensions de 4x4 (est ce pour simplifier les déplacement ou cela apporte-il autre chose ?)

Bien que la réponse soit accepté, je serais intéressé par une explication sur les points précédents.
Encore merci à vous !

Yes merci japee !
J'espère néanmoins avoir toujours quelques nouvelles de f0xie concernant l'optimisation de ce code ...
A bientôt ;)

Ok merci
Concernant l'utilisation de bitblt, je ne connaissais pas CopyRect et je m'étais inspiré d'un code sur ce site de reconnaissance de caractères où il utilisait cette fonction la pour extraire une portion de l'écran dans un TBitmap. Mais je vais utiliser CopyRect pour être un peu plus cohérent ;)

Encore merci à vous