Charge images couche alpha png ou tif sauve en tif et png deplacement transparent
5/5 (8 avis)
Vue 5 526 fois - Téléchargée 634 fois
Description
c'est la suite de la source déja sur ce site
DÉPLACER UN OBJET TRANSPARENT (PNG AVEC COUCHE ALPHA) SUR UN PICTUREBOX EN VB6
la grosse différence c'est que j'ai résolu le problème
de la sauvegarde d'une image avec couche alpha en PNG et en TIF
je me suis souvenu que le format TIF acceptait la non compression et la couche alpha(un Bitmap 32 bits compatible contrairement au BMP) j'ai écrit un convertisseur Bitmap32->Tif puis je converti le TIF en PNG (gdiplus.dll)
J'ai beaucoup cherché sur ce site
je pense être le seul à proposer une sauvegarde PNG avec couche alpha (et sans DLL additionnelle)
Je suis ouvert à une solution plus directe
Mais je vous offre un code assez léger, rapide et qui surtout
fonctionne
DÉPLACER UN OBJET TRANSPARENT (PNG AVEC COUCHE ALPHA) SUR UN PICTUREBOX EN VB6
la grosse différence c'est que j'ai résolu le problème
de la sauvegarde d'une image avec couche alpha en PNG et en TIF
je me suis souvenu que le format TIF acceptait la non compression et la couche alpha(un Bitmap 32 bits compatible contrairement au BMP) j'ai écrit un convertisseur Bitmap32->Tif puis je converti le TIF en PNG (gdiplus.dll)
Source / Exemple :
Option Explicit
Dim WP&, HP& 'largeur et hauteur de l'E.T.
Dim BP() As Byte 'Bitmap 32 bits avec couche Alpha de l'E.T.
Dim HeP As BITMAPINFO 'Bitmap 24 bits(BVR)
Dim Wi&, Hi& 'largeur et hauteur de l'image principale (Picture1)
Dim Bi() As Byte, HeI As BITMAPINFO 'Bitmap 24 bits(BVR)
Dim Xm&, Ym& 'Cordonnées de la souris sur picture2 lors de Picture2_MouseDown
Dim HTif(&HEFF) As Byte 'Header Tif 32 Bits
Private Sub Form_Load()
Caption = "Déplacez l'E.T. avec la souris - Cranach 1530~ Adam et Eve au Jardin d'Eden"
'charge l'image de fond dans Picture1 au bon endroit
Picture1.ScaleMode = vbPixels
Picture1.BorderStyle = 0 'None
Picture1.AutoSize = True
'L'image Principale est déja dans le Picture1
'Picture1.Picture = LoadPicture("Cranach 1530~ Adam et Eve au Jardin d'Eden.jpg")
'ajuste la taille de la Form
Width = Picture1.Width + (Width - ScaleWidth)
Height = Picture1.Top + Picture1.Height + (Height - ScaleHeight)
Label1.Width = ScaleWidth
Label1.Font.Size = (Screen.TwipsPerPixelY + 1) / 2
'extrait le Bitmap 24 Bits de picture1
Wi = Picture1.ScaleWidth
Hi = Picture1.ScaleHeight
With HeI 'Initialise le Header BITMAPINFO
.biSize = 40
.biWidth = Wi
.biHeight = Hi
.biPlanes = 1
.biBitCount = 24
End With
ReDim Bi(Width24b(Wi) - 1, Hi - 1) 'on ne peux faire un tableau à 3 dimension que si Wi est divisible pas 4
GetDIBits Picture1.hdc, Picture1.Picture, 0, Hi, Bi(0, 0), HeI, 0 'DIB_RGB_COLORS
'Converti ET.png en Bmp 32bits vers TMP fichier temporaire
Dim TMP$
TMP = Environ("TMP") & "\ET.tmp"
'Convert "ET.png", TMP, 0 '0 conversion vers BMP
Convert "ET.png", TMP, 0 '0 conversion vers BMP
'extait les dimensions et le bitmap 32 bits(avec couche alpha) de TMP
Open TMP For Binary As 1
Get 1, 19, WP 'largeur de l'ET
Get 1, , HP 'hauteur de l'ET
ReDim BP(3, WP - 1, HP - 1)
Get 1, 55, BP 'bitmap lu
Close 1
Kill TMP 'efface le fichier temporaire
'initialise Picture2
Picture2.ScaleMode = vbPixels
Picture2.BorderStyle = 0 'None
Picture2.AutoRedraw = True
Picture2.Width = WP
Picture2.Height = HP
'Dessine et Place Picture2
PlacePicture2 376, 244
'Fin de l'ancien Projet
'teste la presence de HeaderTif32.bin
If Dir("HeadTif32.bin") = "" Then MsgBox "HeaderTif32.bin non trouvé !": Exit Sub
Dim X&, Y&, TMPTif$, TMPPng$
'Charge le Header HTif
Open "HeaderTif32.bin" For Binary As 1: Get 1, , HTif: Close 1
'Recopie Picture2 ver picture1
Picture1.AutoRedraw = True
Picture1.PaintPicture Picture2.image, 376, 244, WP, HP, 0, 0, WP, HP
'Picture2.Visible = False
'Exit Sub
'recharge la nouvelle image dans le tableau bitmap BI
Picture1.Picture = Picture1.image
GetDIBits Picture1.hdc, Picture1.Picture, 0, Hi, Bi(0, 0), HeI, 0 'DIB_RGB_COLORS
'rendre l'ET plus transparent(affaiblir la couche alpha)
For Y = 0 To HP - 1: For X = 0 To WP - 1: BP(3, X, Y) = 0.65 * BP(3, X, Y): Next X, Y
'sauve le bitmap32 en tif32 (avec couche alpha)
TMPTif = Environ("TMP") & "\TmpTif.tif"
'TMPTif = "TmpTif.tif"
Bitmap32ToUncompressedTif BP, TMPTif
'Convertir le TIF en PNG
TMPPng = Environ("TMP") & "\TmpPng.png"
Convert TMPTif, TMPPng, 1
'Convertir le PNG en en Bmp32
Convert TMPPng, TMP, 0
'On recharge le BitMap32 qui a subi 3 conversions Bitmap32->TIF->PNG->Bitmap32
Open TMP For Binary As 1
Get 1, 19, WP 'largeur de l'ET
Get 1, , HP 'hauteur de l'ET
ReDim BP(3, WP - 1, HP - 1)
Get 1, 55, BP 'bitmap lu
Close 1
'On efface les 3 fichiers temporaires
Kill TMPTif
Kill TMPPng
Kill TMP
'On replace le nouvel ET plus tranparent au même endroit
PlacePicture2 376, 244
'voila c'est tout j'ai fait beaucoup de manipulatios dont le seul but était
'de montrer comment sauver en PNG avec couche Alpha (accessoirement comment sauver en TIF)
End Sub
Private Sub Bitmap32ToUncompressedTif(B() As Byte, TifFile$)
Dim X&, Y&, YI&, W&, H&, UW&, UH&, D() As Byte
If UBound(B) <> 3 Then MsgBox "Pas de couche Alpha": End
UW = UBound(B, 2): W = UW + 1
UH = UBound(B, 3): H = UH + 1
'On entre la Largeur W,la hauteur H et la taille du bitmap32 4 * W * H dans le header HTif
CopyMemory HTif(&H1E), W, 2
CopyMemory HTif(&H2A), H, 2
CopyMemory HTif(&H72), H, 2
CopyMemory HTif(&H7E), 4 * W * H, 4
ReDim D(3, UW, UH)
'Inversion Y et permutation Rouge Bleu
For Y = 0 To UH: YI = UH - Y
For X = 0 To UW
D(0, X, Y) = B(2, X, YI) 'rouge
D(1, X, Y) = B(1, X, YI) 'vert
D(2, X, Y) = B(0, X, YI) 'bleu
D(3, X, Y) = B(3, X, YI) 'alpha
Next X, Y
'on sauve, le tif est prêt
H = FreeFile
Open TifFile For Binary As H
Put H, , HTif: Put H, , D
Close H
End Sub
Private Sub Picture2_MouseDown(Button%, Shift%, X!, Y!)
Xm = X: Ym = Y
End Sub
Private Sub Picture2_MouseMove(Button%, Shift%, X!, Y!)
If Button Then
PlacePicture2 X + Picture2.Left - Xm, Y + Picture2.Top - Ym
Picture1.Refresh ' Nettoyage de Picture1
End If
End Sub
Private Sub PlacePicture2(X0&, Y0&)
Dim X0i&, Y0r& 'origines dans le bitmap de l'image principale Bi
Dim Wu&, Hu& 'largeur et hauteur de la zone à copier
Dim Xt&, Yt&, X&, C& 'variables de travail
Dim B() As Byte 'Bitmap 24 Bits qui sera chargé dans Picture2
Dim Alpha! 'niveau d'opacité de 0 à 1
Dim NAlpha! 'niveau de transparence de 0 à 1 (1-Alpha)
X0i = X0
Y0r = Hi - Y0 - HP 'les ccordonnées Y du bitmap sont inversées (de bas en haut)
'Vérifications pour ne pas sortir du tableau Bitmap Bi (image principale)
Wu = WP: If X0 + WP > Wi Then Wu = Wi - X0i
If X0i < 0 Then Xt = -X0i: Wu = Wu + X0i: X0i = 0
Hu = HP: If Y0r + HP > Hi Then Hu = Hi - Y0r
If Y0r < 0 Then Yt = -Y0r: Hu = Hu + Y0r: Y0r = 0
'Cree un bitmap 24 bits de la taille de picture2 (ET)
ReDim B(Width24b(WP) - 1, HP - 1)
If Wu > 0 And Hu > 0 Then
Wu = 3 * Wu: Xt = 3 * Xt: X0i = 3 * X0i
'Copie le Bitmap de l'image principale (Bi) sous picture2 dans le nouveau bitmap (B)
For Yt = Yt To Yt + Hu - 1
CopyMemory B(Xt, Yt), Bi(X0i, Y0r), Wu: Y0r = Y0r + 1
Next
'Fusionne le Bitmap B avec BP(avec couche alpha)
For Yt = 0 To HP - 1
For Xt = 0 To WP - 1
If BP(3, Xt, Yt) Then
Alpha = BP(3, Xt, Yt) / 255:
NAlpha = 1 - Alpha
X = 3 * Xt 'B et Bi sont à 2 dimensions BP à 3
For C = 0 To 2
B(X, Yt) = Alpha * BP(C, Xt, Yt) + NAlpha * B(X, Yt)
X = X + 1
Next
End If
Next
Next
'charge le nouveau Bitmap B dans Picture2.image et Picture2.picture
With HeP 'place les dimensions dans le Header BITMAPINFO
.biSize = 40
.biWidth = WP
.biHeight = HP
.biPlanes = 1
.biBitCount = 24
End With
SetDIBits Picture2.hdc, Picture2.image, 0, HP, B(0, 0), HeP, 0 'DIB_RGB_COLORS
Picture2.Picture = Picture2.image
End If
'Positionne Picture2
Picture2.Left = X0: Picture2.Top = Y0
Picture2.Refresh
End Sub
'les fonctions GetDibits, SetDibits de même que le format de fichier BMP
'utilisent un tableau dont la taile est:
' 4 * ((BitPerPixel * Width + 31)\ 32) * Height
'si (BitPerPixel * Width) est divible par 32 on peut faire un tableau à 3 dimensions C,X,Y sinon non
Private Function Width24b&(Width&)
Width24b = 4 * ((24 * Width + 31) \ 32)
End Function
Conclusion :
J'ai beaucoup cherché sur ce site
je pense être le seul à proposer une sauvegarde PNG avec couche alpha (et sans DLL additionnelle)
Je suis ouvert à une solution plus directe
Mais je vous offre un code assez léger, rapide et qui surtout
fonctionne
Codes Sources
A voir également
- Hp png
- Tif to png - Meilleures réponses
- Tif alpha - Meilleures réponses
- Delphi couche alpha images PNG ✓ - Forum - Delphi / Pascal
- Visual Basic / VB.NET : Déplacer un objet transparent (png avec couche alpha) sur un pictureb - Guide
- Chargement image ds un picturebox (redimentionement,proportion,centrage) - Codes sources - Visual Basic / VB.NET (Graphique)
- PHP : Fonction de miniaturisation d'image jpeg gif png - CodeS SourceS - Guide
- Visual Basic / VB.NET : Insérer une image au format png dans n'importe quel objet visual basi - Guide
qui est indispensable au fonctionnement du programme et pourtant indépendant de l'image .png de départ
Dans l'hypothèse où ce fichier.bin serait absent ,corrompu ou perdu comment en 'reconstruit'-t' on un nouveau?
Merci,aussi à votre réponse précédente.Chatou
L'ET se dedouble, ce n'est pas un Bug
L'ET original est opaque, son double est transparent
En réponse à Schwerdtle
Ce n'est effectivement pas PhotoShop
Simplement en regardant bien dans le code
on trouve comment charger une image alpha
à partir d'un PNG, d'un TIF ou d'un BMP32Bit
comment l'utiliser, la déplacer
comment la sauver en TIF et la convertir en PNG
(le convertisseur utilisé Gdi+ faisant correctement la conversion PNG -> BMP32 mais pas BMP32 -> PNG)
On ne peut nier la réussite du statut pédagogique de ce site !
P.
- Messages postés
-
17286
- Date d'inscription
- mercredi 2 janvier 2002
- Statut
- Modérateur
- Dernière intervention
- 23 décembre 2019
69Il ne s'agit ici que d'une illustration de l'affichage d'un PNG translucide, dans un picturebox.
Ca n'est pas un studio d'animation, et enregistrer des animations issus d'un déplacement de la chose dénaturerai la coté pédagogique de la chose.
Exact pour le commentaire de Chatou, même remarque.
Comment "enregistrer sous" l'image obtenue une fois
le petit Alien déplacé ?
Etant dans le dessin animé, j'ai fait des déplacements du dessin *.png
avec boucle et timer.
Comment charger via un menu des PNG et les faire bouger "simplement", à l'instar d'un logiciel de pré-visionnage de dessin animé (Story-board)..
Bon, ceci dit, cela n'impose pas de réponse, et bravo encore.
Cordialement
Pat
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.