Rotation de bitmap (bis)

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Je rebondis sur le sujet (récent) ouvert par l'ami Papydall et j'en ouvre un autre pour ne pas polluer le sien.
Il proposait une rotation d'image pixel par pixel par appel d'une dll système.

Ici c'est pareil, également pixel par pixel (donc traitement long évidemment), mais en Panoramic pur, sans appel de ressources externes.

Deux subs:
1) une rotation visuelle d'un angle donné d'une image d'un picture donné avec résultat dans un second picture
2) une rotation d'un angle donné d'un fichier image (jpg, bmp) dans un fichier résultat, avec choix de la couleur de remplissage des vides (forcément, le résultat est rectangulaire...). Le traitement est plus long.

On peut essayer les deux, il suffit d'adapter en tête les chemins des deux fichiers.
Avec mon image test de 365 x 224 pixels (piquée à papydall Very Happy

), la première sub met 37 secondes, la deuxième 55 secondes, soit environ 1,5 fois plus.

Code:: rem ============================================================================
rem Rotation d une image bitmap
rem ============================================================================
dim w%,h%,d%,bmp$,t%,fr$,angle%,tst%
bmp$ = "C:\GRAPH\BMP\moto.bmp": ' 365 x 224 pixels
fr$ = "Z:\Result.bmp"
FONT_BOLD 0: ALPHA 1: ALPHA 2: TOP 2,15

angle% = 15: ' rotation de 15 degrés à droite (par exemple)
tst% = 1: ' Test sub 1: rotation d'un picture
' tst% = 2: ' Test Sub 2: rotation d'un fichier image

IF tst% = 1
FILEBIN_OPEN_READ 1,bmp$: ' dimensions de l'image
FILEBIN_POSITION 1,18: w% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_POSITION 1,22: h% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_CLOSE 1
d% = SQR(w%*w%+h%*h%): ' diagonale de l'image, dimensions de l'espace résultat
WIDTH 0,w%+d%+50: HEIGHT 0,d%+60: BORDER_SMALL 0: COLOR 0,200,255,255: font_bold 0
PICTURE 10: WIDTH 10,w%:HEIGHT 10,h%: TOP 10,30: LEFT 10,10
FILE_LOAD 10,bmp$
PICTURE 20: WIDTH 20,d%: HEIGHT 20,d%: TOP 20,10: LEFT 20,w%+20: COLOR 20,200,255,255
CAPTION 1,TIME$+" image "+str$(w%)+" x "+str$(h%)+" traitement en cours..."
t% = NUMBER_TICKS: ' Début
ImgRotn(10,20,angle%): ' rotation 10° à droite
t% = (NUMBER_TICKS-t%)/1000
CAPTION 2,TIME$+", durée= "+STR$(t%)+" secondes.": ' Fin"
ELSE
CAPTION 1,TIME$+" traitement en cours..."
t% = NUMBER_TICKS: ' Début
ImgRotF(bmp$,fr$,angle%,255): ' couleur de remplissage: bleu
t% = (NUMBER_TICKS-t%)/1000
CAPTION 2,TIME$+", durée= "+STR$(t%)+" secondes.": ' Fin"
END_IF
END
rem ============================================================================
SUB ImgRotn(p1%,p2%,rot%)
' Pivoter l'image du picture p1% d'un angle de rot% degrés, dans le picture p2%
' long, opération pixel par pixel: environ 2 minutes pour image 640x480)
DIM_LOCAL ra,wi%,hi%,xc%,yc%,w2%,xc1%,yc1%,x%,y%,x1%,y1%,sra,cra
wi% = WIDTH(p1%): hi% = HEIGHT(p1%)
ra = rot%*PI/180: ' angle de rotation, en radians
xc% = wi%/2: yc% = hi%/2: ' pivot de rotation (centre de l'image)
w2% = INT(SQR(wi%*wi%+hi%*hi%)): ' diagonale (dimensions maxi du résultat)
xc1% = w2%/2: yc1% = xc1%: ' centre du résultat
2D_TARGET_IS p2%
sra = SIN(ra): cra = COS(ra)
FOR y% = 0 TO hi%-1
FOR x% = 0 TO wi%-1
x1% = INT(cra*(x%-xc%)-sra*(y%-yc%)+xc1%)
y1% = INT(sra*(x%-xc%)+cra*(y%-yc%)+yc1%)
2D_PEN_COLOR COLOR_PIXEL_RED(p1%,x%,y%),COLOR_PIXEL_GREEN(p1%,x%,y%),COLOR_PIXEL_BLUE(p1%,x%,y%)
2D_CIRCLE x1%,y1%,1: ' i/o 2d_point, pour éviter les pixels blancs
NEXT x%
display
NEXT y%
END_SUB
rem ============================================================================
SUB ImgRotF(f$,fr$,rot%,rgb%)
' Pivoter un fichier image f$ (bmp, jpg) de rot% degrés, résultat dans fr$ (bmp)
' rgb% = couleur de remplissage des vides (sous la forme R*65536 + G*256 + B)
DIM_LOCAL ft$,p1%,p2%,im%,w%,h%,d%,ra,sra,cra,xc%,yc%,xc1%,yc1%,x%,y%,x1%,y1%
DIM_LOCAL r%,g%,b%,xmin%,ymin%,xmax%,ymax%
ft$ = "Z:\Ftmp.bmp"
p1% = 950: p2% = p1%+1: im% = p2%+1
PICTURE p1%: HIDE p1%: FILE_LOAD p1%,f$
IF UPPER$(FILE_EXTRACT_EXTENSION$(f$)) <> "BMP" THEN FILE_SAVE p1%,ft$: f$ = ft$
FILEBIN_OPEN_READ 1,f$
FILEBIN_POSITION 1,18: w% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_POSITION 1,22: h% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_CLOSE 1
IF f$ = ft$ THEN FILE_DELETE ft$
WIDTH p1%,w%: HEIGHT p1%,h%
d% = SQR(w%*w%+h%*h%): ' diagonale de l'image, dimensions maxi de l'espace résultat
PICTURE p2%: HIDE p2%: WIDTH p2%,d%: HEIGHT p2%,d%
r% = INT(rgb%/65536): g% = BIN_AND(rgb%,65280)/256: b% = BIN_AND(rgb%,255)
COLOR p2%,r%,g%,b%: ' couleur de fond du résultat (remplissage des vides)
ra = rot%*PI/180: ' angle de rotation, en radians
xc% = w%/2: yc% = h%/2: ' pivot de rotation (centre de l'image)
xc1% = d%/2: yc1% = xc1%: ' centre du résultat
2D_TARGET_IS p2%
sra = SIN(ra): cra = COS(ra): xmin% = d%: ymin% = d%: xmax% = 0: ymax% = 0
FOR y% = 0 TO h%-1
FOR x% = 0 TO w%-1
x1% = INT(cra*(x%-xc%)-sra*(y%-yc%)+xc1%)
y1% = INT(sra*(x%-xc%)+cra*(y%-yc%)+yc1%)
IF x1% < xmin% THEN xmin% = x1%
IF x1% > xmax% THEN xmax% = x1%
IF y1% < ymin% THEN ymin% = y1%
IF y1% > ymax% THEN ymax% = y1%
2D_PEN_COLOR COLOR_PIXEL_RED(p1%,x%,y%),COLOR_PIXEL_GREEN(p1%,x%,y%),COLOR_PIXEL_BLUE(p1%,x%,y%)
2D_CIRCLE x1%,y1%,1: ' i/o 2d_point, pour éviter les pixels blancs
NEXT x%
display
NEXT y%
IF FILE_EXISTS(fr$) = 1 THEN FILE_DELETE fr$
IMAGE im%: 2D_IMAGE_COPY im%,xmin%,ymin%,xmax%,ymax%: FILE_SAVE im%,fr$
2D_TARGET_IS 0: DELETE p1%: DELETE p2%: DELETE im%
END_SUB
' ==============================================================================

Remarque: dans le cas d'une rotation d'un multiple de 90°, il est bien préférable d'utiliser un script vbs, beaucoup plus rapide (voir l'exemple dans le post de papydall).

Edit: correction suite à une remarque de papydall

Hello JL35
Very good, But Sad

Spoiler:

Spoiler:

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Ça alors, je l'ai pourtant passé dans tous les sens je n'ai jamais eu d'erreur... bon, je regarde...

et au même endroit dans les deux subs... scratch

Et pourquoi cette fameuse valeur 0.965925...etc... ne serait-elle pas une valeur flottante valide ?
Et c'est curieux, c'est exactement la même valeur dans les deux subs, donc au même endroit je suppose...
en tout cas je n'arrive pas à reproduire l'erreur... avec cette image ou d'autres...

Bon, voici la solution (il faut bien que j’y participe un peu pour que cette jolie fille ne souffre pas du courant d’air)
Il suffit (mais allez savoir pourquoi ?) de modifier les 2 lignes 50 et 51 (à cause de cra et sra qui sont des flottants)

Code:: x1% = int(cra*(x%-xc%)-sra*(y%-yc%)+xc1%)
y1% = int(sra*(x%-xc%)+cra*(y%-yc%)+yc1%)

Même chose pour les lignes 85 et 86

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Eh bien un grand merci pour le tuyau papydall, mais je croyais que le fait d'affecter un entier (%) à la valeur faisait automatiquement l'arrondi à la valeur entière la plus proche... et en plus c'est ce que j'ai toujours constaté
jusqu'ici...

Contrairement à INT qui arrondit à l'entier inférieur.

Je confirme:
v = 1.8
i% = v donne i% = 2 (arrondi à la valeur entière la plus proche)
i% = INT(v) donne i% = 1 (seulement la partie entière de v)
ce qui change quand même les résultats des calculs...

C’est curieux !
Mon idée du INT marche sur le 1er SUB et pas sur le second !
J’ai utilisé la commande DEGREES pour utiliser directement les degrés sans passer par une conversion en radians ; et il m’a semblait que ça a bien fonctionné sans le INT pour x1% et y1%.
Ouf !!!! "Mille millions de mille milliards de mille sabords !!!"
Impossible to run … et tout est perdu !

Je pense que je vais me reposer un bon moment, car cet Impossible to run … commence à me taper sur les nerfs.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

C'est vrai que c'est crispant ce truc, quand on perd ce qu'on est en train de faire, sans raison apparente !
Ça fait bien 24 heures que je ne l'ai pas eu, mais je me méfie.
Je mets la sauvegarde à 5 minutes, mais cette valeur n'est pas conservée d'une fois à l'autre, ça revient à l'implicite 10 minute.
Et puis c'est un pis-aller, en 5 minutes on peut en faire des modifs qu'on perd complètement.

Quant à l'INT... comme ça ne plante pas chez moi je vais revenir en arrière, je préfère la valeur la plus proche à la partie entière seule.

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Dans la même série (rotation d'images), pour faire une rosace (avec une image, ou des images différentes de mêmes dimensions).
Ici 8 images en cercle, mais on peut varier.

Code:: LABEL Creimg
DIM r$,nbi%,pa%,i%,f$,ff$,fr$(20),a%,c%,w%(20),h%(20),r1%,r2%,wp%,xc%,yc%,x%,y%
r$ = "Z:\"
f$ = r$+"Ouf.bmp"

nbi% = 8: ' nombre d'images en cercle
pa% = 360/nbi%

FOR i% = 0 TO nbi%-1: fr$(i%) = r$+"i"+STR$(i%)+".bmp": NEXT i%
IF FILE_EXISTS(fr$(nbi%-1)) = 0
GOSUB Creimg: ' création des images pivotées
END_IF

FOR i% = 0 TO nbi%-1
FILEBIN_OPEN_READ 1,fr$(i%): ' dimensions des images
FILEBIN_POSITION 1,18: w%(i%) = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_POSITION 1,22: h%(i%) = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_CLOSE 1
NEXT i%
r1% = (nbi%/2)*w%(0)/PI: r2% = r1%+h%(0)/2
wp% = 2*(h%(0)+r1%)
WIDTH 0,wp%+20: HEIGHT 0,wp%+40: color 0,180,255,255: border_small 0
PICTURE 10: WIDTH 10,wp%: HEIGHT 10,wp%
IMAGE 20
xc% = wp%/2: yc% = wp%/2
2D_TARGET_IS 10: 2D_FILL_OFF
DEGREES: a% = 90: ' angle de départ
FOR i% = 0 TO nbi%-1
FILE_LOAD 20,fr$(i%)
y% = yc%-r2%*SIN(a%): x% = xc%+r2%*COS(a%): ' centre de l'image
x% = x%-w%(i%)/2: y% = y%-h%(i%)/2
2D_IMAGE_PASTE 20,x%,y%
a% = a%-pa%
NEXT i%
END
' ==============================================================================
Creimg:
EDIT 1
c% = 255*256*256+255*256+255: ' blanc: couleur de fond des images inclinées
a% = 0
FOR i% = 1 TO nbi%-1
a% = a%+pa%
fr$(i%) = "Z:\i"+STR$(i%)+".bmp"
ImgRotF(f$,fr$(i%),a%,c%)
TEXT 1,STR$(i%)
NEXT i%
DELETE 1
RETURN
' ==============================================================================
SUB ImgRotF(f$,fr$,rot%,rgb%)
' Pivoter un fichier image f$ (bmp, jpg) de rot% degrés, résultat dans fr$ (bmp)
' rgb% = couleur de remplissage des vides (sous la forme R*65536 + G*256 + B)
' Durée du traitement: 1 seconde pour environ 1500 pixels d'image
DIM_LOCAL ft$,p1%,p2%,im%,w%,h%,d%,sra,cra,xc%,yc%,xc1%,yc1%,x%,y%,x1%,y1%
DIM_LOCAL r%,g%,b%,xmin%,ymin%,xmax%,ymax%
ft$ = "Z:\Ftmp.bmp"
p1% = 950: p2% = p1%+1: im% = p2%+1
PICTURE p1%: HIDE p1%: FILE_LOAD p1%,f$
IF UPPER$(FILE_EXTRACT_EXTENSION$(f$)) <> "BMP" THEN FILE_SAVE p1%,ft$: f$ = ft$
FILEBIN_OPEN_READ 1,f$: ' dimensions de l'image source (pixels)
FILEBIN_POSITION 1,18: w% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_POSITION 1,22: h% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_CLOSE 1
IF f$ = ft$ THEN FILE_DELETE ft$
WIDTH p1%,w%: HEIGHT p1%,h%
d% = SQR(w%*w%+h%*h%): ' diagonale de l'image, dimensions maxi de l'espace résultat
PICTURE p2%: HIDE p2%: WIDTH p2%,d%: HEIGHT p2%,d%
r% = INT(rgb%/65536): g% = BIN_AND(rgb%,65280)/256: b% = BIN_AND(rgb%,255)
COLOR p2%,r%,g%,b%: ' couleur de fond du résultat (remplissage des vides)
xc% = w%/2: yc% = h%/2: ' pivot de rotation (centre de l'image)
xc1% = d%/2: yc1% = xc1%: ' centre du résultat
2D_TARGET_IS p2%
DEGREES: sra = SIN(rot%): cra = COS(rot%)
xmin% = d%: ymin% = d%: xmax% = 0: ymax% = 0
FOR y% = 0 TO h%-1
FOR x% = 0 TO w%-1
x1% = cra*(x%-xc%)-sra*(y%-yc%)+xc1%
y1% = sra*(x%-xc%)+cra*(y%-yc%)+yc1%
xmin% = MIN(x1%,xmin%): xmax% = MAX(x1%,xmax%)
ymin% = MIN(y1%,ymin%): ymax% = MAX(y1%,ymax%)
2D_PEN_COLOR COLOR_PIXEL_RED(p1%,x%,y%),COLOR_PIXEL_GREEN(p1%,x%,y%),COLOR_PIXEL_BLUE(p1%,x%,y%)
2D_CIRCLE x1%,y1%,1: ' i/o 2d_point, pour éviter les pixels blancs
NEXT x%
NEXT y%
IF FILE_EXISTS(fr$) = 1 THEN FILE_DELETE fr$
IMAGE im%: 2D_IMAGE_COPY im%,xmin%,ymin%,xmax%,ymax%: FILE_SAVE im%,fr$
2D_TARGET_IS 0: DELETE p1%: DELETE p2%: DELETE im%
END_SUB
' ==============================================================================

Adapter en tête le répertoire de travail et le chemin de l'image de base.

Vous reconnaîtrez quelqu'un d'ici

PS (edit) ajout d'une variable pour le nombre d'images en cercle (nbi%)

Merci JL35

et Bonne soirée

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Y'a pas de quoi mon ami, et bonne soirée à toi aussi !

Tiens, dans le même esprit, deux petites subs qui peuvent être utiles pour faire la rosace ci-dessus:
- découpage d'une zone donnée dans une image
- redimensionnement d'une image (en respectant les proportions ou non)

Code:: ' ==============================================================================
SUB Crop(f$,fr$,x%,y%,w%,h%)
' Découpage d'une zone dans une image f$ (JPG, BMP) -> fr$ (BMP) (clip si fr$ = "")
PICTURE 950: HIDE 950
IMAGE 951
FILE_LOAD 950,f$: 2D_TARGET_IS 950
2D_IMAGE_COPY 951,x%,y%,x%+w%-1,y%+h%-1
WIDTH 950,w%: HEIGHT 950,h%: 2D_IMAGE_PASTE 951,0,0
2D_TARGET_IS 0
IF fr$ = ""
CLIPBOARD_COPY 951
ELSE
FILE_SAVE 950,fr$
END_IF
DELETE 950: DELETE 951
END_SUB
' ==============================================================================
SUB RedimImg(f$,fr$,w%,h%)
' Redimensionnement proportionnel d'une image f$ (JPG, BMP) -> fr$ (BMP)
' Si fr$ = "", résultat dans le clipboard
' w%,h% = nouvelles dimensions. Si h% = 0: redimensionnement proportionnel.
' ATTENTION: l'image résultante doit tenir dans l'écran
DIM_LOCAL ftm$,sf$,h%,wi%,hi%,wb%,hb%
ftm$ = "Z:\Ficfic.bmp"
sf$ = f$
FORM 949: HIDE 949
PICTURE 950: PARENT 950,949: FULL_SPACE 950
wb% = WIDTH(949)-WIDTH(950): hb% = HEIGHT(949)-HEIGHT(950)
IMAGE 951
IF UPPER$(FILE_EXTRACT_EXTENSION$(f$)) = ".JPG"
FILE_LOAD 950,f$: FILE_SAVE 950,ftm$: f$ = ftm$
END_IF
FILEBIN_OPEN_READ 1,f$: ' dimensions des images
FILEBIN_POSITION 1,18: wi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_POSITION 1,22: hi% = FILEBIN_READ(1)+256*FILEBIN_READ(1)
FILEBIN_CLOSE 1
IF f$ = ftm$ THEN FILE_DELETE ftm$
IF h% <= 0 THEN h% = w%*hi%/wi%: ' nouvelle hauteur proportionnelle implicite
WIDTH 949,w%+wb%: HEIGHT 949,h%+hb%: FULL_SPACE 950
STRETCH_ON 950: FILE_LOAD 950,sf$: SHOW 949: DISPLAY
2D_TARGET_IS 949: 2D_IMAGE_COPY 951,0,0,w%,h%: HIDE 949
IF fr$ = ""
CLIPBOARD_COPY 951
ELSE
FILE_SAVE 951,fr$
END_IF
2D_TARGET_IS 0: DELETE 949: DELETE 951
END_SUB
' ==============================================================================

C'est sympa !
Que de bonnes idées !
Merci JL35 !

Excellent;)

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Merci.
Et le tout en pur P. (Panoramic, pas perte !)

Heu...Qu' as tu voulu faire en mettant Ouf_ca_passe le tête à l' envers ?
Y aurait il un message subliminal ?... scratch

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Regarde son image, il se pose la question lui-même... mais je ne sais pas si c'est à moi que ça s'adresse...

https://fr.wikipedia.org/wiki/La_T%C3%AAte_%C3%A0_l'envers

Cordialement

Ouf_ca_passe
autosurnommé le Gandalf des Pano

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Ne va pas croire que je cherchais à te faire tourner la tête, même si ça y ressemble ! Wink

JL35 a écrit:: Je confirme:
v = 1.8
i% = v donne i% = 2 (arrondi à la valeur entière la plus proche)
i% = INT(v) donne i% = 1 (seulement la partie entière de v)
ce qui change quand même les résultats des calculs...

Oui, JL35, tu as raison.

Pour obtenir un arrondi correct avec INT(v), il faut ajouter 0.5 à la variable :
INT(v) devient INT(v+0.5).

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Ben oui, il fallait juste y penser !
Merci Marc !

Code:: rem ============================================================================
rem ROUND
rem ============================================================================
Round(123.456789,3) : ' <---- 123.457
' Round(-123.456789,2) : ' <---- -123.46
' Round(1.5,0) : ' <---- 2
' Round(-0.8,0) : ' <---- -1
message round
end
rem ============================================================================
' Arrondir un nombre réel avec decimal% décimales
SUB Round(Nombre,decimal%)
if variable("round") = 0 then dim round
round = int(Nombre * power(10,decimal%) + 0.5) / power(10,decimal%)
END_SUB
rem ============================================================================

Nombre de messages : 7095 Localisation : 77 Date d'inscription : 29/11/2007

Intéressant pour avoir un nombre de décimales donné.
Je vais mettre cette petite sub dans ma bibliothèque, pas la peine de réinventer l'eau chaude à chaque fois.
Merci papydall.

» Rotation de bitmap
» Une pseudo-police bitmap
» un bitmap et sa dimention
» Rotation d'un rectangle
» Rotation de texte