|
Trouver une ressource
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)
Informations & options pour cette discussion
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
|
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
|
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
|
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
|
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
|
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 : 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
|
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
Livres en rapport
|
Téléchargements
Logiciels à télécharger sur le même thème :
|