5/5 (8 avis)
Vue 5 905 fois - Téléchargée 650 fois
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
10 juin 2009 à 13:14
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
2 mars 2009 à 21:58
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)
2 mars 2009 à 13:55
On ne peut nier la réussite du statut pédagogique de ce site !
P.
2 mars 2009 à 13:31
Il 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.
2 mars 2009 à 13:01
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.