DROLE DE TRUC (JL'AI PAS FAIT EXPRÉS!!!)

Signaler
Messages postés
52
Date d'inscription
vendredi 26 avril 2002
Statut
Membre
Dernière intervention
28 octobre 2003
-
Messages postés
16
Date d'inscription
jeudi 1 mai 2003
Statut
Membre
Dernière intervention
29 décembre 2004
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/12220-drole-de-truc-jl-ai-pas-fait-expres

Messages postés
16
Date d'inscription
jeudi 1 mai 2003
Statut
Membre
Dernière intervention
29 décembre 2004

Voilà la procédure corrigée et optimisée qui fonctionne à présent à merveille !
Une unité à ajouter : Math.
Remarques :
- j'ai inversé X et Y pour que X corresponde à la colonne et non à la ligne de pixels du bitmap à modifier.
- j'ai ajouté un contrôle des variables de boucle "for" pour que le programme ne plante plus lorsque les X et Y entrés sont "trop près du bord" et que le programme cherche en conséquence à modifier des pixels hors de l'image.

procedure MakeLight(X, Y : Integer; D : Byte ; Bmp : TBitmap);
var
I, J, Adding : Integer;
P : pRGBTripleArray;
begin
D := D div 2;
for j := max(0, Y-D) to min(Y+D, bmp.Height-1) do begin
P := bmp.ScanLine[j];
for i := max(0, X-D) to min(X+D, bmp.Width-1) do begin
adding := 255 - min(trunc(255*(sqrt(sqr(i-X)+sqr(j-Y))/D)),255);
P[i].rgbtRed := min(255, P[i].rgbtRed + adding);
P[i].rgbtGreen := min(255, P[i].rgbtGreen + adding);
P[i].rgbtBlue := min(255, P[i].rgbtBlue + adding);
end;
end;
end;
Messages postés
16
Date d'inscription
jeudi 1 mai 2003
Statut
Membre
Dernière intervention
29 décembre 2004

Voilà la procédure corrigée qui fonctionne à présent à merveille :
Une unité à ajouter : Math.

procedure MakeLight(X, Y : Integer; Intensity : Byte ; Bmp : TBitmap);
var
I, J, Adding : integer;
RowOriginal : pRGBTripleArray;
begin
for I:= max(0, X-(Intensity div 2)) to min(X+(Intensity div 2), bmp.Height-1) do begin
RowOriginal:=bmp.ScanLine[I];
for J:= max(0, Y-(Intensity div 2)) to min(Y+(Intensity div 2), bmp.Width-1) do begin
adding := 255 - min(trunc(255*(sqrt(sqr(I-X)+sqr(J-Y))/(Intensity div 2))),255);
if RowOriginal[J].rgbtRed+adding > 255 then
RowOriginal[J].rgbtRed:=255 else
inc(RowOriginal[J].rgbtRed,adding);
if RowOriginal[J].rgbtGreen+adding > 255 then
RowOriginal[J].rgbtGreen:=255 else
inc(RowOriginal[J].rgbtGreen,adding);
if RowOriginal[J].rgbtBlue+adding > 255 then
RowOriginal[J].rgbtBlue:=255 else
inc(RowOriginal[J].rgbtBlue,adding);
end;
end;
end;
Messages postés
52
Date d'inscription
vendredi 26 avril 2002
Statut
Membre
Dernière intervention
28 octobre 2003

heu... le bitmap doi tetre au pixelformat:=pf24bit;
voila, bye.