Vous ne trouvez pas de réponse à votre problème ? Alors posez la question dans le forum. Souvenez-vous qu'il n'y a jamais de question bête, mais rester dans l'ignorance parce que l'on n'ose pas poser une question, ça c'est une erreur !

Sujet : Aide pour ce qui ressemble à un bug dans mon programme svp ... [ Système / Mémoire ] (cerber943)

mardi 17 octobre 2006 à 23:28:04 | Aide pour ce qui ressemble à un bug dans mon programme svp ...

cerber943

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 :)


mercredi 18 octobre 2006 à 01:54:56 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

f0xi

Membre Club Administrateur CodeS-SourceS



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)

mercredi 18 octobre 2006 à 02:33:03 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

f0xi

Membre Club Administrateur CodeS-SourceS
Réponse acceptée !




sinon voila une petite modif qui fonctionne trés bien et affiche de bonne performances :


type
  TZoom = array[0..3,0..3] of TBitmap;

var
  ZM  : TZoom;
  BMP : TBitmap;

procedure CreateZoom(var Dest : TZoom);
var X,Y: integer;
begin
  for Y := 0 to 3 do
      for X := 0 to 3 do
          Dest[Y,X] := TBitmap.Create;
end;

procedure DestroyZoom(var Dest : TZoom);
var X,Y: integer;
begin
  for Y := 0 to 3 do
      for X := 0 to 3 do
          FreeAndNil(Dest[Y,X]);
end;

procedure CutZoom(Src : TBitmap; var Dest : TZoom);
var nX,nY,CX,CY,NW,NH : integer;
    Buffer : TBitmap;
begin
  NW := Src.Width  shl 2;
  NH := Src.Height shl 2;

  Buffer := TBitmap.Create;
  Buffer.Assign(Src);
  Buffer.Width  := NW;
  Buffer.Height := NH;
  Buffer.Canvas.StretchDraw(Rect(0,0,Buffer.Width,Buffer.Height),Src);

  CX := NW shr 2;
  CY := NH shr 2;

  for nY := 0 to 3 do
      for nX := 0 to 3 do
          with Dest[nY,nX] do begin
             PixelFormat := Buffer.PixelFormat;
             Width  := CX;
             Height := CY;
             Canvas.CopyRect( Rect(0, 0, CX, CY),
                              Buffer.Canvas,
                              Rect(nX*CX, nY*CY, (nX+1)*CX, (nY+1)*CY)
                             );
          end;
     
  Buffer.Free;
end;


procedure TForm1.FormCreate(Sender: TObject);
begin
  BMP := TBitmap.create;
  BMP.LoadFromFile('blablabla.bmp');
  CreateZoom(ZM);
  CutZoom(BMP,ZM);
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  DestroyZoom(ZM);
  BMP.free;
end;



Croc (click me)

mercredi 18 octobre 2006 à 02:47:24 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

japee

Membre Club Administrateur CodeS-SourceS
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

mercredi 18 octobre 2006 à 02:49:34 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

japee

Membre Club Administrateur CodeS-SourceS
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 +

mercredi 18 octobre 2006 à 09:07:38 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

cerber943

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 !

mercredi 18 octobre 2006 à 12:44:18 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

japee

Membre Club Administrateur CodeS-SourceS
Réponse acceptée !
Salut,

En fait, il faut opter pour un tableau de 0..15, sinon les calculs sont faussés.
Ce qui donne :

coding.gif

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

var
  ZonesCar: TZonesCar;

procedure FreeZonesCar;
var i: Integer;
begin
  for i := 0 to 15 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:=0 to 15  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;


Cette fois c'est la bonne !

Bonne prog'

mercredi 18 octobre 2006 à 12:56:16 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

cerber943

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

mercredi 18 octobre 2006 à 17:09:07 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

f0xi

Membre Club Administrateur CodeS-SourceS
Réponse acceptée !

bah les seules que je vois c'est ça (en reprennant le code de japee) :


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

var
  ZonesCar: TZonesCar;

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

procedure DecoupeCar(car : TBitmap; var ZoneCar : TZonesCar);
var gdImg : TBitmap;
    i,x,y,l,h : Integer;
begin
  gdImg := TBitmap.Create;
  with gdImg do begin
     Width  := (car.Width  + car.Width mod 2) shl 2;
     Height := (car.Height + car.Height mod 2) shl 2;
     l := Width shr 2;
     h := Height shr 2;
     Canvas.StretchDraw(Canvas.ClipRect, car);
  end;
  for i:=0 to 15  do
  begin
    x := (i mod 4) * l;
    y := (i shr 2) * h;
    ZoneCar[i] := TBitmap.Create;
    with
ZoneCar[i] do begin
       Height := h;
      
Width  := l;
       bitblt(
Canvas.Handle,0, 0, l, h, gdImg.Canvas.Handle, x, y, srccopy);
    end;
  end;
  gdImg.Free;
end;


par contre je vois pas trop pourquoi l'utilisation de BitBlt. Canvas.CopyRect fonctionne aussi bien .


Croc (click me)

mercredi 18 octobre 2006 à 17:16:40 | Re : Aide pour ce qui ressemble à un bug dans mon programme svp ...

cerber943

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



Cette discussion est classé dans : zones, width, height, tbitmap, gdimg


Répondre à ce message

Sujets en rapport avec ce message

Convertion d'un Jpeg en Bitmap puis stockage dans un tableau [ par dami ] Bonjour a tous. Pour les besoins d'OpenGL, j'ai besoin de transformer mon Jpeg en BMP puis de stocker le BMP sous forme de tableau. J'ai récupéré et a Convertion d'un Jpeg en Bitmap puis stockage dans un tableau [ par dami ] Bonjour a tous. Pour les besoins d'OpenGL, j'ai besoin de transformer mon Jpeg en BMP puis de stocker le BMP sous forme de tableau. J'ai récupéré et a Bitmap, tableau de stockage .... [ par dami ] Bonjour a tous. Pour les besoins d'OpenGL, j'ai besoin de transformer mon Jpeg en BMP puis de stocker le BMP sous forme de tableau. J'ai récupéré et a Probleme erreur [ par cricri_b34 ] salut , j'ai fait un programme qui doit crer des composant tout fonctionne bien sauf quand je quitte, la ya plein d'erreur qui apparaisse je comprend redimensionner paintbox selon form.resize [ par seba31stien ] Bonjour, je souhaiterais redimensionner les dimensions de ma paintbox en fonction de la taille de la form. si l'utilisateur divise par deux la fiche, Appli en plein écran ? [ par seba31stien ] Bonjour, il doit exister un moyen de savoir si l'appli est en plein écran. j'envisage de comparer form.width et form.height à screen.width et screen.h Question sur l'utilisation des TBitmap dans les fonctions... [ par cerber943 ] Bonjour, J'ai créé quelques fonctions qui retournent des TBitmap. Je rencontre actuellement une augmentation de l'espace mémoire alloué à mon programm Problème d'affichage d'une Image1.Canvas.Pen.Mode [ par cincap ] Bonsoir à toutes et à tous,Je dispose de deux fiche, sur la 1ère (formvisu) je charge une photo dans un Timage et j'ai un Tprintersetupdialog, sur la Mon image refuse de se redimensionner [ par Jean_Jean ] <v:shapetype id="_x0000_t75" stroked="f" filled="f" path="m@4@5l@4@11@9@11@9@5xe" o:preferrelative="t" o:spt="75" coordsiz [Composant] Diminution de la visibilité d'une propriété [ par Bacterius ] Bonjour, je suis en train de faire un composant ('rrahh toujours avec ses composants lui') visuel (pour changer) et j'ai un petit problème. Mon compos


Nos sponsors

Sondage...

CalendriCode

Juillet 2009
LMMJVSD
  12345
6789101112
13141516171819
20212223242526
2728293031  

Consulter la suite du CalendriCode

Téléchargements

Comparez les prix Nouvelle version

Photothèque Nouveau !



Développement réalisé par Nicolas SOREL (Nix) avec l'aide de : Cyril DURAND et Emmanuel (EBArtSoft), Merci à Vincent pour ses précieux conseils
CodeS-SourceS.com© Toute reproduction même partielle est interdite sauf accord écrit du Webmaster
CodeS-SourceS.com© est une marque déposée tous droits réservés
Temps d'éxécution de la page : 0,452 sec

Google Coop CodeS-SourceS Google Coop CodeS-SourceS


Certaines images présentes sur le site (notament certains avatars) sont issues des collections IconShock, donc si vous souhaitez utiliser ces icons vous devez les acheter, ne les copiez pas et ne utilisez pas dans vos sites et applications sans les avoir commandé.