2 pièce(s) jointe(s)
Redimensionnement d'image
Bonjour,
sur cette page on peut trouver des routines 1 de redimensionnement d'image qui se compilent et s'exécutent bien sous D7 perso (sous Win2000) sauf une (la première), qui ignore le redimensionnement horizontal :aie:
Pièce jointe 273180
(original à gauche, réduction à droite)
Quelle peut bien être l'instruction manquante ?
Code:
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 27 28 29 30
| procedure Squash(bmpS, bmpD: TBitmap);
var
scanlS, scanlD: Pointer;
widthS, widthD: integer;
yS, sInc, yD: integer;
begin
{assume correct size for bitmaps and assume pixelformat of 24bpp
for both. These could be precomputed but it wouldnt save much time}
widthS := integer(bmpS.Scanline[1]) - integer(bmpS.Scanline[0]);
widthD := integer(bmpD.Scanline[1]) - integer(bmpD.Scanline[0]);
{how many scanlines to move down in source, per dest scanline}
sInc := (bmpS.Height shl 16) div bmpD.Height;
scanlS := bmpS.Scanline[0];
scanlD := bmpD.Scanline[0];
yS := 0;
for yD := 0 to bmpD.Height - 1 do
begin
{copy scanline}
Move(scanlS^, scanlD^, bmpD.Width * 3); {assumes pf24bit}
inc(yS, sInc);
{move down whole number of scanlines}
inc(integer(scanlS), widthS * (yS shr 16));
{and update yS to reflect the move}
dec(yS, yS and $FFFF0000);
inc(integer(scanlD), widthD);
end;
end; |
1 : si certains veulent en tester d'autres, il y a un microscopique bug de typo dans la routine 2, invisible tant qu'on ne réorganise pas un peu le code, comme ça :
Code:
1 2 3
| pc[x*3 +2] := (Col1b*w1 + Read[(t+1)*3 +2]*w2 + Col2b*w3 + Read2[(t+1)*3 +2] * w4) shr 15;
pc[x*3 +1] := (Col1g*w1 + Read[(t+1)*3 +1]*w2 + Col2g*w3 + Read2[(t+1)*3 +1] * w4) shr 15;
pc[x*3 ] := (Col1r*w1 + Read2[(t+1)*3 ]*w2 + Col2r*w3 + Read2[(t+1)*3 ] * w4) shr 15; |
correction (dernière ligne, suppression d'un "2" en trop) :
Code:
1 2 3
| pc[x*3 +2] := (Col1b*w1 + Read[(t+1)*3 +2]*w2 + Col2b*w3 + Read2[(t+1)*3 +2] * w4) shr 15;
pc[x*3 +1] := (Col1g*w1 + Read[(t+1)*3 +1]*w2 + Col2g*w3 + Read2[(t+1)*3 +1] * w4) shr 15;
pc[x*3 ] := (Col1r*w1 + Read[(t+1)*3 ]*w2 + Col2r*w3 + Read2[(t+1)*3 ] * w4) shr 15; |
Maintenant attention : je me suis rendu compte que ces routines à base de Scanline produisaient des résultats très moches (en bas sur l'image) quand il s'agissait de travailler sur du texte, et que la fonction StretchDraw était sur ce coup-là bien plus performante (en haut), pour une durée d'exécution (sous Lazarus et Linux) similaire.
Démonstration avec un fichier de test créé par mes soins (800x600, réduit à 400x300) :
Pièce jointe 273176