Sauvegarder d'une picturebox ...

Question

Bien le bonjour,

J'en appelle ici aux spécialistes des méthodes graphiques sous VB6.

Je voudrais sauvegarder l'image contenue dans une picturebox après que cette image ait été modifiée(conversion en niveaux de gris).

J'ai essayé la méthode Savepicture, mais le résultat est toujours le même, une image en couleur identique à l'originale et redimensionnée.

Comment faire pour sauver cette image en niveaux de gris et sans la redimensionner?

cs_DARKSIDIOUS · Answer

Il te faut faire : Picture1.Picture = Picture1.Image AVANT de la sauvegarder, ainsi, tout les tracés ou manipulations que tu as pu faire sur ton image (stockés dans le Image) seront transférés dans le Picture de l'image et seront enregistrés normalement avec un SavePicture.

DarK Sidious

[Responsable API/VB du site www.ProgOtoP.com]
Téléchargez ProgOtoP API Viewer

Cugel · Answer

Ben oui, mais, au risque de passer pour un neuneu, çà marche pas.

Je fais :

PicReview.Picture=PicReview.Image
Savepicture PicReview.Picture, sFileName

et j'obtiens toujours la même image originale.

J'ai aussi essayé en passant pas un second controle PictureBox caché, mais idem.

J'ai aussi essayé en modifiant les propriétés AutoRedraw et ScaleMode mais au mieux j'arrive simplement à ne plus afficher l'image du tout.

Alors je sèche vraiment ...

cs_DARKSIDIOUS · Answer

Pourrais-tu nous mettre ton code pour voir la où ca coince stp ?

DarK Sidious

[Responsable API/VB du site www.ProgOtoP.com]
Téléchargez ProgOtoP API Viewer

Cugel · Answer

Okay, sorry, j'avais mal corrigé ma procédure, désolé.

Mais il me reste encore un problème :

Après la mise en niveaux de gris, mon image finale possèdes des pixels gris là où il ne devrait y avoir que du blanc.  Je suppose que cela vient du fait que certaines parties de la photos sont surexposées, mais y aurait-il un moyen d'éviter cela?

Voici le code demandé :


Option Explicit
'-----------------------------------------------
' Déclaration des variables et constantes
'-----------------------------------------------
Private Declare Function SetPixelV Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Byte
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, _
    ByVal x As Long, ByVal y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, _
    ByVal x As Long, ByVal y As Long, ByVal crColor As Long) As Long

Dim sLecteur As String
Dim sRep As String
Dim sFileName As String
Private Const sNewExt As String = ".bum"

Private Sub GreyScale()
'---------------------------------------------------------------------------------------
' Procedure     : GreyScale
' Projet        : Projet1
' Date          : 04/05/2004
' Auteur        : trouvé sur le net (VBFrance je crois)
'                 si l'auteur se reconnait, qu'il me fasse
'                 signe
' Objectif      : transforme une image couleur en niveaux de
'                 gris
' Type de proc. : Sub
'---------------------------------------------------------------------------------------
'
' ------------------------------------------------------
' Variables utilisées pour la mise en niveaux de gris
' ------------------------------------------------------
'
Dim R1, R2, R3, r, g, b As Integer
Dim TCol As Long
Dim Colour As Long
Dim x, y As Integer
R1 = 256
R2 = 256
R3 = 256

' ------------------------------------------------------
' Routine de mise en niveaux de gris
' ------------------------------------------------------

For x = 0 To picTraitement.ScaleWidth
    For y = 0 To picTraitement.ScaleHeight
        ' On récupère la couleur du pixel
        TCol = GetPixel(picTraitement.hdc, x, y)
        r = TCol Mod R1
        g = (TCol / 256) Mod R2
        b = TCol / 256 / R3
        Colour = r * 0.3 + g * 0.59 + b * 0.11
        ' Affectation de la nouvelle couleur au pixel
        SetPixel picTraitement.hdc, x, y, RGB(Colour, Colour, Colour)
    Next
Next

End Sub

Private Sub cmdGreyScale_Click()
' ------------------------------------
' Transformation de l'image couleur en
' niveaux de gris et sauvegarde sous
' un nom de fichier temporaire.
' -------------------------------------
MousePointer = vbHourglass

' On passe en niveaux de gris
Call GreyScale

' Affecte l'image en mémoire (traitée) au
' picturebox
picTraitement.Picture = picTraitement.Image
' Sauvegarde de l'image dans un fichier temporaire

MousePointer = vbArrow

SavePicture picTraitement.Picture, App.Path & "\Temp.bmp"
' Ouvre le fichier temporaire dans picPreview
LoadPic App.Path & "\Temp.bmp", picPreview, True
End Sub

Private Function LoadPic(Chemin As String, Destination As PictureBox, Optional Centrage As Boolean = True)
'---------------------------------------------------------------------------------------
' Procedure     : ChargeImage
' Projet        : Converter
' Date          : 04/04/2004
' Auteur        : inconnu, trouvé sur VBFrance
' Objectif      : Redimensionne une image dans un picturebox sans la déformer.
' Type de proc. : Function
'---------------------------------------------------------------------------------------
'
Dim Pic As StdPicture
Dim x As Long
Dim y As Long
Dim Coeff As Long
Dim NewWidth As Long
Dim NewHeight As Long
Set Pic = LoadPicture(Chemin)
Destination.AutoRedraw = True

' Si la taille est plus petite que le picturebox
If Pic.Width < Destination.Width And Pic.Height < Destination.Height Then
    Coeff = 1
    x = (Destination.Width - Pic.Width) / 2
    y = (Destination.Height - Pic.Height) / 2
    GoTo Affiche_Image
End If

' Définition du Coefficient selon l'orientation de l'image
If Pic.Width > Pic.Height Then
    Coeff = Pic.Width / Destination.Width
    x = 0
    y = (Destination.Height - (Pic.Height / Coeff)) / 2
Else
    Coeff = Pic.Height / Destination.Height
    x = (Destination.Width - (Pic.Width / Coeff)) / 2
    y = 0
End If

Affiche_Image:
    Destination.Cls
    NewWidth = Pic.Width / Coeff
    NewHeight = Pic.Height / Coeff
    If Centrage = True Then
        Destination.PaintPicture Pic, x, y, NewWidth, NewHeight
        
    Else
        Destination.PaintPicture Pic, 0, 0, NewWidth, NewHeight
    End If
    
End Function

Private Sub dirRepertoire_Change()
filFichiers.Path = dirRepertoire.Path
sRep = dirRepertoire.Path
End Sub

Private Sub drvDrive_Change()
dirRepertoire.Path = drvDrive.Drive
End Sub

Private Sub filFichiers_Click()
LoadPic sLecteur & sRep & "" & filFichiers.FileName, picPreview, False
picTraitement.Picture = LoadPicture(sLecteur & sRep & "" & filFichiers.FileName)

End Sub

cs_DARKSIDIOUS · Answer

Qu'entend-tu par "certaines parties de la photos sont surexposées" ? Je ne comprend pas trop ton problèmes, et surtout d'où ca peut venir !

DarK Sidious

[Responsable API/VB du site www.ProgOtoP.com]
Téléchargez ProgOtoP API Viewer

Cugel · Answer

Désolé pour le retard dans ma réponse (petit problème de FAI).

Prenons l'exemple d'une photo représentant un maison par temps clair avec des nuages blancs dans le ciel.

les nuages blancs se retrouveront, sur la photo retraitée, avec ques pixels gris-noirs (alors qu'ils devraient rester noirs).

J'ai poser la question sur un autre forum où on m'a répondu que cela venait de ce que ma carte vidéo était certainemnt paramétrée en 16 bits couleurs lors que l'image finale était en 24 bits. Oui, mais voilà, ma carte est paramétrée en 32 bits ...

Je continue à creuser, mais je pencherais plutôt pour un problème venant de l'algorithme...

Sauvegarder d'une picturebox ...

6 réponses

Discussions similaires