Déplacer un objet transparent (png avec couche alpha) sur un picturebox en vb6

Télécharger le projet
Commenter

Description

Une image RVB est chargé dans Picture1
Picture1.picture est Convertit en tableau Bitmap 24 Bits(GetDibits)
Un fichier PNG(alpha) est convertit en Bitmap 32 bits
Pour Positioner L'image transparente
On crée un bitmap 24 bits à la taille de l'image PNG (GdiPlus)
On recopie le Fond,
on combine pixel par pixel avec le bitmap 32bits
on charge le bitmap résulatant dans picture2 (SetDibits)
on positionne Picture2
Pédagogique, rapide assure un déplacement fluide de l'objet

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 Wi&, Hi& 'largeur et hauteur de l'image principale (Picture1)
Dim Bi() As Byte, HeP As BITMAPINFO 'Bitmap 24 bits(BVR)
Dim Xm&, Ym& 'Cordonnées de la souris sur picture2 lors de Picture2_MouseDown

'Necessite AlphaPng.bas

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.Height + (Height - ScaleHeight)
'extrait le Bitmap 24 Bits de picture1
Wi = Picture1.ScaleWidth
Hi = Picture1.ScaleHeight
With HeP '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), HeP, 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
'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
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
 .biWidth = WP
 .biHeight = HP
 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 :


Pédagogique
relativement simple
ne necessite pas d'autre dll que GdiPlus.dll qui est déja sur le PC
efficace, facilement réutilisable

Je sais depuis aujoud'hui manipuler les PNGs transparents
Je ne sais toujours pas convertir un BitMap 32 Bits en PNG
A l'aide (La coversion par GdiPlus perd la couche alpha)
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

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.

Du même auteur (deleplace)