Discussion :

[Jipété]

Bonsoir,

Voilà ce que je gagne quand je compile le projet en cours d'étude, ça concerne Scanline et Bitmap :

Error: Call by var for arg no. 3 has to match exactly: Got "tagRGBQUAD" expected "PRGBQUAD"

et voilà la ligne qui a généré ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
MakecouleurH( col, Pixels[wi], Pixels[wi+colwidth] ); // avec le curseur qui clignote 
// avant la dernière parenthèse, soulignée d'une vaguelette rouge qui se prolonge sous le point-virgule.

Cet imbécile de compilateur n'est même pas d'accord avec lui-même puisque plus loin il m'agresse avec :

Hint: Found declaration: TForm2.MakecouleurH(var TBitmap,var PRGBQUAD,var PRGBQUAD) is nested;

et moi, je ne sais pas ce qu'il me raconte...
L'infobulle en dit un peu plus mais il faut faire une copie d'écran pour avoir les infos :



Indépendamment de la ponctuation aléatoire qui n'aide pas à la compréhension, qu'en conclure ? Qu'il n'a pas trouvé d'overloaded procédure ? C'est normal, il n'y en a pas.
Bref, incompréhensible, ce qui ne me fait pas avancer dans la résolution du problème.

Revenons à MakecouleurH :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
    procedure MakecouleurH(var aCol: TBitmap; var pColDeb, pColFin: pRGBQuad);
    begin
      DrawMultiGradient(aCol.Canvas.Handle, Rect(0,0,aCol.Width,1),
        [RGBAtoColor(pColDeb), RGBAtoColor(pColFin)], False);
    end;

Je récupère deux TColor avec RGBAtoColor pour fabriquer un dégradé, pas de quoi fouetter un chat, alors si quelqu'un a une idée, je la lirai avec grand plaisir parce que je suis salement coincé, là...
Bien sûr j'ai tenté des trucs idiots, genre

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

procedure MakecouleurH(var aCol: TBitmap; var pColDeb: pRGBQuad; var pColFin: pRGBQuad);

mais faut pas rêver, hein.

[tourlourou]

TForm2.MakecouleurH(var TBitmap,var PRGBQUAD,var PRGBQUAD) m'étonne : Pixels[] est-il un tableau de PRGBQUAD ou de TRGBQUAD ?
De même le RGBAtoColor(pColDeb) au lieu de RGBAtoColor(pColDeb^), du coup.
Sinon, essaye de passer par des variables intermédiaires pour les paramètres.

[Roland Chastain]

Bonjour Jipété!

Je n'ai pas la solution mais il y a une ou deux choses que je ne comprends pas bien dans ton code. Premièrement je ne vois pas l'intérêt de passer des pointeurs à ta procédure. Pourquoi pas directement des valeurs plutôt ? Deuxièmement, pourquoi déclarer des paramètres de type var ? Enfin, je ne comprends pas non plus pourquoi tu passes des pointeurs à la fonction RGBAToColor. Mais c'est peut-être moi qui suis à côté de la plaque.

[Jipété]

Coucou, Yves

TForm2.MakecouleurH(var TBitmap,var PRGBQUAD,var PRGBQUAD) m'étonne : Pixels[] est-il un tableau de PRGBQUAD ou de TRGBQUAD ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
  var
    Pixels: pRGBQuad;

Exemple d'utilisation (extrait d'un vieux projet d'étude) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
procedure TForm1.ComputeArray;
var
  h, w: integer;
  gray: integer;
begin
  bmp.BeginUpdate();
  for h := 0 to HSIZE-1 do
  begin
    Pixels := pRGBQuad(bmp.RawImage.GetLineStart(h));
 
    if h = 0 then        // ligne du haut, rouge -- mars 2019 : non, bleue !
      for w := 0 to WSIZE-1 do                   // j'inverse dessous :
        Pixels[w] := RGBAtoBGRA(255,0,0,255) // (0, 0, 255, 255)
    else                                         // et bleue en pf32, dessous cyan ok
    if h = HSIZE-1 then  // ligne du bas,  cyan
      for w := 0 to WSIZE-1 do
        Pixels[w] := RGBAtoBGRA(255,255,0,255)
    else                 // entre les deux
      for w := 0 to WSIZE-1 do begin
        gray := round((h+w) * ratio);   // le dégradé gris
        if gray > 255 then gray := round(gray * ratio);
        Pixels[w] := RGBAtoBGRA(gray, gray, gray, trkTranspar.Position);
      end;
  end;
  bmp.EndUpdate();
end;

Ici, ce qui me turlupine le plus, c'est que si on regarde attentivement le début de la procédure appelée, c'est comme ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

procedure MakecouleurH(var aCol: TBitmap; var pColDeb, pColFin: pRGBQuad);

Il y a donc 3 objets, les deux derniers du même type.
Et je l'appelle ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MakecouleurH( col, Pixels[wi], Pixels[wi+colwidth] )

Et le compilateur m'agresse à propos du troisième
Pour être bien sûr, stupide d'un point de vue algo, j'ai testé avec

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MakecouleurH( col, Pixels[wi], Pixels[wi] )

et j'ai le même message désagréable.
Pourquoi sur le troisième et pas sur le deuxième, ou les deux ?
À partir de là je suis sec...

De même le RGBAtoColor(pColDeb) au lieu de RGBAtoColor(pColDeb^), du coup.

J'ai tout tenté.
Soit c'est l'insulte soit c'est image noire.

Sinon, essaye de passer par des variables intermédiaires pour les paramètres.

À quoi ça sert d'avoir des pointeurs et du scanline si on ne peut pas les utiliser ?
Sinon, tu verrais ça comment, toi ?


Pour Roland :

si j'utilise du var c'est parce que c'est censé aller beaucoup plus vite, c'est l'adresse de l'objet qui est passée, plutôt qu'une recopie de l'objet.
De toute façon, avec ou sans, c'est le message abscons…

[Roland Chastain]

si j'utilise du var c'est parce que c'est censé aller beaucoup plus vite, c'est l'adresse de l'objet qui est passée, plutôt qu'une recopie de l'objet.
De toute façon, avec ou sans, c'est le message abscons…

Le pointeur est déjà une adresse.

Remarque aussi que quand on écrit Pixels[w], on n'obtient pas une adresse (comme on pourrait le croire), mais une valeur. On le voit bien dans l'exemple que tu as donné :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Pixels[w] := RGBAtoBGRA(255,0,0,255) // (0, 0, 255, 255)

Ou encore dans ce petit exemple que je te propose :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
var
  s: string; 
  p: ^char;
 
begin
  s := 'abc';
  p := @s[1];    // adresse du premier caractère
  WriteLn(p^);   // premier caractère
  WriteLn(p[1]); // deuxième caractère
end.
 
{
  a
  b
}

Maintenant, pourquoi le compilateur signale le troisième paramètre et non pas le deuxième, je n'en sais rien mais peu importe : il a raison quand même.
Probablement que si tu corriges le troisième, il te signalera alors le deuxième.

[Jipété]

Probablement que si tu corriges le troisième, il te signalera alors le deuxième.

Le tout c'est d'y arriver : j'ai enlevé var, restons simple, et je renomme les variables pour plus de précision à la lecture :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
procedure MakecouleurH(var aCol: TBitmap;  pCouleurDeb, pCouleurFin: pRGBQuad);
// je mets tout dans le même bloc CODE mais c'est juste pour de la lisibilité forumesque 
 
MakecouleurH( col, Pixels[wi], Pixels^[wi+colwidth] )
//me donne
Error: No default property available
 
MakecouleurH( col, Pixels[wi], Pixels[wi+colwidth]^ ) 
//me donne
Error: Illegal qualifier
 
MakecouleurH( col, Pixels[wi], Pixels[wi+colwidth] ) 
//me donne 
Error: Incompatible type for arg no. 3: Got "tagRGBQUAD", expected "PRGBQUAD"

Si tu vois comment corriger, ça m'intéresse,

[Roland Chastain]

Pas sûr mais j'essaierais ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MakecouleurH( col, @Pixels[wi], @Pixels[wi+colwidth] )

[Jipété]

Pas sûr

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

MakecouleurH( col, @Pixels[wi], @Pixels[wi+colwidth] )

Merci le compilo avec tes messages complètement hors sujet

Allez, après un arrêt au stand, la course reprend,

Merci Roland,

[Jipété]

De haine, j'ai enlevé le ,

Regardez :
C'est toujours la même ligne, suivie par la ligne d'insulte du compilo. Mais quand il dit ce qu'on lit, est-ce vraiment vrai ? On a vu ce matin qu'il y avait à boire et à manger dans ses sorties…

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
Caption := inttostr((((@Pixels[wi]))));
Error: Incompatible type for arg no. 1: Got "Pointer", expected "QWord"
// D'accord, donc je précise mon pointeur :
Caption := inttostr(((pRGBQuad(@Pixels[wi]))));
Error: Incompatible type for arg no. 1: Got "PRGBQUAD", expected "QWord"
// là c'est inttostr qui n'est pas content, arrangeons ça :
Caption := inttostr((QWord(pRGBQuad(@Pixels[wi]))));
// ça compile et ça s'exécute en donnant ça : 3056543384

pas sûr que ça soit un TColor correct, d'autant plus que ça varie d'exécution en exécution alors que wi ne change pas (j'ai cassé les boucles pour essayer de savoir pourquoi je n'ai pas de couleurs)

on recommence à partir du début en tentant un autre itinéraire :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Caption := inttostr((((@Pixels[wi]))));
Error: Incompatible type for arg no. 1: Got "Pointer", expected "QWord"
// d'où
Caption := inttostr(((pRGBQuad(@Pixels[wi]))));
Error: Incompatible type for arg no. 1: Got "PRGBQUAD", expected "QWord"
// ça tombe bien, RGBAtoColor attend du pRGBquad : function RGBAtoColor(var aPixel: pRGBQuad): TColor;
// donc :
Caption := inttostr((RGBAtoColor(pRGBQuad(@Pixels[wi]))));
Error: Can't assign values to an address

Ah ! Et sans arrobase ?
ça compile, mais à l'exécution

Le projet project1 a levé une exception de class "External: SIGSEGV".
dans le fichier "unit2.pas" à la ligne 193:
B := aPixel^.rgbBlue;

marche arrière

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
Caption := inttostr((RGBAtoColor((Pixels[wi]))));
unit2.pas(361,50) Error: Call by var for arg no. 1 has to match exactly: Got "tagRGBQUAD" expected "PRGBQUAD"
// ah oui, l'arrobase !
Caption := inttostr((RGBAtoColor((@Pixels[wi]))));
unit2.pas(361,51) Error: Can't assign values to an address

D'autant plus curieux que si je passe @Pixels[wi] à MakecouleurH pour qu'elle appelle une procédure de dégradé à qui elle passe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

RGBAtoColor(le_pRGBquad_passé)

, ça ne m'insulte pas. Image noire mais pas d'explosion de haine ou de vengeance.

Bref, ça commence sérieusement à me les briser menu-menu, parce que si un code fonctionne (vous avez vu l'image) et qu'un autre sur le même moule non, c'est pas d'un forum dont j'ai besoin, mais d'un marabout bien fourni en poulets à sacrifier.

[tourlourou]

Un RGBQUAD ou un TColor ne sont-ils pas des structures de 4 octets et un QWord une donnée de 8 octets, non ? Si les pointeurs sont de 8 octets, c'est sous 64 Bits, non ? Ca passerait pê en 32 bits, par contre.

[tourlourou]

@Jean-Pierre : pour favoriser la lecture du code et lever les soucis de trantypages et avertissements ésotériques, il faudrait pê te simplifier la vie, même si ce n'est pas toujours facile en essayant de faire coller des bouts de code collectés avec les siens...
Par exemple,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
procedure MakecouleurH(var aCol: TBitmap; var pColDeb, pColFin: pRGBQuad);
    begin
      DrawMultiGradient(aCol.Canvas.Handle, Rect(0,0,aCol.Width,1),
        [RGBAtoColor(pColDeb), RGBAtoColor(pColFin)], False);
    end;

utilise des noms qui ne parlent que dans ta logique de cette application.
Si son but est de dessiner un dégradé (horizontal ?) dans un bitmap, pourquoi le bitmap est-il passé en var (pas nécessaire), et pourquoi s'appelle-t-il aCol ?
S'il doit accepter des RGBQuads à transmettre après transformation en TColor sans les modifier, pourquoi les passer en var ? Et pourquoi sous forme de pointeurs sur des RGBQuads ?

Je comprends la syntaxe suivante, très proche du C :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
var Pixels: pRGBQuad;    
begin
  Pixels := pRGBQuad(bmp.RawImage.GetLineStart(h));

mais j'aurais plutôt écrit en Pascal (non testé) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
var Pixels: array of RGBQuad;    
begin
  Pixels := bmp.RawImage.GetLineStart(h);

pour être sûr que les Pixels[i] soient des RGBQuads.

Caption := inttostr((QWord(pRGBQuad(@Pixels[wi]))));
pas sûr que ça soit un TColor correct, d'autant plus que ça varie d'exécution en exécution alors que wi ne change pas

Normal, c'est l'adresse d'une valeur, pas la valeur elle-même.

Caption := inttostr((RGBAtoColor((@Pixels[wi]))));
unit2.pas(361,51) Error: Can't assign values to an address

Il faudrait le code de RGBAToColor pour savoir ce qu'il attend. Si le paramètre est en var, ça explique pê l'erreur. En principe, il n'a d'ailleurs pas besoin de l'être, puisqu'il devrait d'après son nom se contenter de convertir une valeur RGBA en TColor.

[Jipété]

Un RGBQUAD ou un TColor ne sont-ils pas des structures de 4 octets et un QWord une donnée de 8 octets, non ?

Si si, mais c'est pour faire plaisir au compilo. Rappel d'une erreur :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Caption := inttostr( pRGBQuad(@Pixels[wi]) );
Error: Incompatible type for arg no. 1: Got "PRGBQUAD", expected "QWord"

Il faudrait le code de RGBAToColor pour savoir ce qu'il attend.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
function RGBAtoColor(var aPixel: pRGBQuad): TColor;//// inline; // empêche le pas-à-pas !
var
  R,G,B,A: Byte;
begin
  B := aPixel^.rgbBlue;
  G := aPixel^.rgbGreen;
  R := aPixel^.rgbRed;
  A := 255; // aPixel.rgbReserved;
  Result := (A shl 24) or (B shl 16) or (G shl 8) or R;
end;

C'est moi qui l'ai bricolé à la va-vite en m'inspirant de RGBtoColor, dans Graphics, qui est écrit ainsi :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
function RGBToColor(R, G, B: Byte): TColor;
begin
  Result := (B shl 16) or (G shl 8) or R;
end;

Si le paramètre est en var, ça explique pê l'erreur.

Je l'enlèverai.

mais j'aurais plutôt écrit en Pascal (non testé) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
var Pixels: array of RGBQuad;    
begin
  Pixels := bmp.RawImage.GetLineStart(h);

et à la compil tu aurais gagné Error: Incompatible types: got "PByte" expected "tagRGBQUAD".
Hé oui... GetLineStart renvoie du pByte, en transtypant en pRGBQuad ça passe, exactement comme dans le code montré au premier post.

pourquoi les passer en var ?

pourquoi le bitmap est-il passé en var (pas nécessaire), et pourquoi s'appelle-t-il aCol ?

var parce qu'on m'a toujours dit que ça allait plus vite,
aCol parce que l'image finale se compose de 24 colonnes (oui, il y a une légère ambiguïté entre aCol et aColor / aCouleur.

Normalement, il s'agit de choses qui auraient été revues à la mise au propre, là j'essaye juste de voir si je vais m'en sortir avec les pBytes et autres pMachins, car si j'emprunte la voie paisible (Canvas.Pixels[w, h]) j'arrive au résultat escompté, mais il faut compter 7 secondes pour une image de 504 x 504 (pourquoi 504 ? Parce que c'est divisible par 24 !), alors pas question de redimensionner la fiche à la souris, c'est un coup à planter toute la pile de messages, ça !

Si son but est de dessiner un dégradé (horizontal ?)

Tutafait.
En gros j'ai 24 colonnes côte-à-côte, chacune dégradée de haut en bas en passant pas sa couleur, le but final est d'avoir un dégradé horizontal de col[n] à col[n+1] et donc j'ai à l'heure actuelle deux options :
- 7 secondes avec le Canvas.Pixels mais je n'ose imaginer le temps qu'il faudrait pour une image 1008x1008
- la crise de nerfs avec les pBytes et consœurs...

Bon, ne vous prenez pas la tête, je regarderai tout ça à tête reposée demain matin (suis plus performant le matin).

Et pour ceux qui aiment les images, à gauche l'étape finale espérée (les couleurs ne sont pas trop bonnes, j'ai pris des images qui traînaient sur le Bureau, mais l'idée est bien rendue), à droite l'étape intermédiaire (où l'on voit bien les 24 colonnes) :

[tourlourou]

Par curiosité, est-ce bien la procédure DrawMultiGradient que tu utilises ?

Un essai pour calmer le compilateur sans trimbaler trop de pointeurs :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
var
  LineStart: PByte;
  Pixels: array of TRGBQuad absolute LineStart; // fait pointer une seconde variable sur une première 
  OnePixel: TRGBQuad;   
begin
  LineStart := bmp.RawImage.GetLineStart(h);
  OnePixel := pixels[0];

[Jipété]

Par curiosité, est-ce bien la procédure DrawMultiGradient que tu utilises ?

C'est tout-à-fait ça !
3 ans déjà, et au moindre écueil c'est encore le naufrage ! Que c'est dur ces Scanline quand on sort du droit chemin…

Un essai pour calmer le compilateur sans trimbaler trop de pointeurs :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
var
  LineStart: PByte;
  Pixels: array of TRGBQuad absolute LineStart; // fait pointer une seconde variable sur une première 
  OnePixel: TRGBQuad;   
begin
  LineStart := bmp.RawImage.GetLineStart(h);
  OnePixel := pixels[0];

Compilateur content, suppression des var, en pas-à-pas dans la fonction RGBAtoColor je vois bien les valeurs correctes de r, g et b, plus qu'à comprendre pourquoi la ligne résultante est noire,
Ça peut être un couple BeginUpdate/EndUpdate mal placé, l'oubli d'un bmp.Canvas.Changed, le passage d'une pluie de neutrinos, la Lune pas dans une phase bénéfique et positive, bref, plein de raisons…
Verrai ça demain.
Mais 10 secondes pour me remplir un bitmap de noir, je dois avoir un sale truc sous le nez, tellement énorme que je ne le vois pas (j'ai une petite idée mais, chut… Demain !)

Grand merci, Yves.

[Jipété]

Bonjour,

Mais 10 secondes pour me remplir un bitmap de noir, je dois avoir un sale truc sous le nez, tellement énorme que je ne le vois pas (j'ai une petite idée mais, chut… Demain !)

Demain c'est aujourd'hui !

Bon, Yves, je ne sais vraiment pas comment te remercier.

J'ai un peu tordu ta solution d'hier soir (j'avais un peu de mal avec ces choses [absolute] que je ne pratique pas, et puis, tous mes vieux codes fonctionnent parfaitement bien avec mon vieux copain pRGBQuad) comme ça, et juste ça :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
    PixelsSrc: pRGBQuad;
    PixelsDst: pRGBQuad;
    OnePixel : pRGBQuad;
    aCouleur : TColor;

Pas besoin de LineStart.
Ensuite, le code devient d'une simplicité terrifiante et d'une rapidité absolue (100 ms pour le dégradé dans les deux sens en une seule passe, à peine plus s'il faut enregistrer le fichier) :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
    map.BeginUpdate();
    for h := 0 to TheDiam-1 do begin // TheDiam c'est "le diamètre" parce qu'à terme 
      // ce bitmap "map" va être la source d'un cercle
      PixelsSrc := pRGBQuad(tmp.RawImage.GetLineStart(h));
      PixelsDst := pRGBQuad(map.RawImage.GetLineStart(h));
      OnePixel  := PixelsDst;
      for w := 0 to nbrecoul-1 do begin// parcours des 24 zones de couleurs unies
        for z := 0 to col.Width-1 do begin // parcours d'une colonne
          // dégrader cette couleur de col[w].Couleur à col[w+1].Couleur
          aCouleur  := ijpGetGradientColor4(iRGBAtoColor(PixelsSrc[w]), iRGBAtoColor(PixelsSrc[w+1]), z/(col.Width-1));
          OnePixel^ := iColorToRGBA(aCouleur);
          // mise de la couleur à la bonne place
          Position := (col.Width * w) + z;
          PixelsDst[Position] := OnePixel^;
        end;
      end;
    end;
    map.EndUpdate();

Bien sûr il aura fallu que je crée auparavant un bitmap tmp de 24 couleurs dégradées de blanc en haut à noir en bas en passant par couleur[n], ces 24 couleurs venant d'une matrice dont on cause beaucoup ici (on a dépassé les 110 posts...)

Il y a du iColorToRGBA comme du ijpGetGradientColor4 : "i" parce que fonction inline, "jp" quand je détourne un bout de code trouvé ailleurs, et que je fournis :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
function ijpGetGradientColor4(CoulDeb, CoulFin: TColor; Percent: Double): TColor; inline;
var
  R1,G1,B1, R2,G2,B2: byte;
  NewRed, NewGreen, NewBlue: Integer;
begin
  if Percent > 1 then Percent := 1;
  if Percent < 0 then Percent := 0;
  ijpColorToRGB(CoulDeb, R1,G1,B1);
  ijpColorToRGB(CoulFin, R2,G2,B2);
  NewRed  := ijpGetPigmentBetween(R1, R2, Percent);
  NewGreen:= ijpGetPigmentBetween(G1, G2, Percent);
  NewBlue := ijpGetPigmentBetween(B1, B2, Percent);
  Result := NewRed + NewGreen * 256 + NewBlue * 65536;
end;

la ijpGetPigmentBetween qui va avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
function ijpGetPigmentBetween(P1,P2,Percent: Double): Integer; inline;
begin
  Result := Round(((P2 - P1) * Percent) + P1);
  if Result > 255 then Result := 255;
  if Result < 000 then Result := 0;
end;

et les conversions RGBA->pRGBQuad->RGBA :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
function iRGBAtoColor(aPixel: TRGBQuad): TColor; inline; // empêche le pas-à-pas ici !
var
  R,G,B,A: Byte;
begin
  B := aPixel.rgbBlue;
  G := aPixel.rgbGreen;
  R := aPixel.rgbRed;
  A := 255; // aPixel.rgbReserved;
  Result := (A shl 24) or (B shl 16) or (G shl 8) or R;
end;
 
function iColorToRGBA(aColor: TColor): TRGBQuad ; inline; // empêche le pas-à-pas ici !
var
  R,G,B: Byte;
begin
  R :=  aColor and $FF;
  G := (aColor shr  8) and $FF;
  B := (aColor shr 16) and $FF;
  WITH RESULT DO BEGIN
    rgbRed   := R;
    rgbGreen := G;
    rgbBlue  := B;
    rgbReserved := 255;
  END
end;

Ah, une info à propos des sources : quand vous voyez des mots-clé en MAJUSCULE comme ci-dessus, c'est qu'en général ça vient de chez efg.

La petite idée dont je parlais a consisté à virer la création du bitmap final avec BitBlt pour n'utiliser que les pRGBQuad, et à faire en un seul balayage vertical ce que je faisais auparavant en deux temps, résultat cette image (réduite de moitié pour ici) générée en 116 msec (enregistrement du fichier compris), et c'est à peu près pareil en cas de redimensionnement à la souris.


Allez, je peux recocher

EDIT :
PS : les maniaques de l'optimisation et de la concision pourront se bricoler une "boîte noire" avec ça, je suis tombé à 67 millisecondes !

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
    colWidth := col.Width;
    colWidth_moins_un := colWidth-1;
    nbrecoul_moins_un := nbrecoul-1;
    TheDiam_moins_un  := TheDiam-1;
    map.BeginUpdate();
    for h := 0 to TheDiam_moins_un do begin
      PixelsDst := pRGBQuad(map.RawImage.GetLineStart(h));
      PixelsSrc := pRGBQuad(tmp.RawImage.GetLineStart(h));
      for w := 0 to nbrecoul_moins_un do
        for z := 0 to colWidth_moins_un do
          PixelsDst[(colWidth*w)+z] :=
            iColorToRGBA(ijpGetGradientColor4(iRGBAtoColor(PixelsSrc[w]), iRGBAtoColor(PixelsSrc[w+1]), z/(colWidth_moins_un)));
    end;
    map.EndUpdate();

EDIT2 :
Voilà, j'avais déjà sous le coude le code en mode "boîte noire" pour passer du carré au cercle, donc je vous fais profiter, et moi je suis très content de la vitesse ! 100 fois plus vite qu'avec Canvas.Pixels[w,h], y a pas photo !
Me suis enflammé trop vite (faut dire aussi que quand on voit ces belles couleurs…), en fait c'est ça qu'il faut obtenir : de blanc à noir en passant par couleur du centre à la périphérie, donc j'ai viré la jolie boule de billard, et j'y retourne...


EDIT3 :
coucou me revoilou :


C'est ça que je voulais, donc et
Et encore merci à Yves.

[Roland Chastain]

Très joli.

Est-ce qu'on peut avoir le code source complet ?

[Jipété]

Très joli.

Est-ce qu'on peut avoir le code source complet ?

Pas d'souci, dès que c'est terminé. Faudra compter qq jours, il reste une bricolette qui risque d'être tendue.

[Jipété]

Bonjour,

Pas d'souci, dès que c'est terminé. Faudra compter qq jours, il reste une bricolette qui risque d'être tendue.

Je ne vous ai pas oubliés.

Sauf que les quelques jours estimés auront pris, au bout du compte, presque 4 semaines,

Bah, tant que c'est pas la fin du monde, on va dire que ça va,

Le zip est quasiment prêt, j'attends juste un dernier retour de wiwaxia, ce n'est donc plus que l'affaire de quelques heures,

Pour faire patienter :

[Jipété]

Tout est là : zip, explications.

Enjoy,

[BeanzMaster]

Salut sympa ton application

Pour Windows suffit juste de passer le pixelformat des TBitmap à pf32bits ou utiliser des TRGBTriple comme tu l'as suggéré.

Sinon il y a 2 erreurs dans la fonction MakeCircle

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 IF w >= 0 THEN Phase:= (-arctan(h/w)) // on est à* droite dans le cercle // ERREUR W=0 DIVISION PAR ZERO
                      ELSE if w< 0 then Phase:= (-arctan(h/w) + Pi)

a remplacer par

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
 IF w > 0 THEN         Phase:= (-arctan(h/w)) // on est à* droite dans le cercle
 ELSE if w< 0 THEN   Phase:= (-arctan(h/w) + Pi) // on y est à* gauche       
 ELSE                       Phase:= (-arctan(h));  // on est au milieu

et il faut modifier

pos_px := (w+rayon); par pos_px := (w+rayon)-1; sinon SIGSEGV --> Index hors limite dans la ligne (on commence a zero. Si la largeur = 100px Index Max = 99px)

A+