Logo GNT
Actualités Tests & Guides Bons Plans
GTA 6 iPhone 17 Copilot Switch 2 Temu ChatGPT Tesla
OVH Cloud OVH Cloud
Entraide Développement Développement Visual Basic UserControl: Comment sauvegarder l'image

UserControl: Comment sauvegarder l'image

2 réponses
Avatar
Sébastien Côté
Sous VB 6...

Comment sauvegarder l'image d'un contrôle personnalisé i.e. à dire que
j'aimerais ajouter a mon User control, qui contient des textbox, labels,
etc. une fonction du type SavePicture.

Merci à l'avance!

Seb
Signaler un problème avec ce contenu

2 réponses

Supprimer
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire

Veuillez sélectionner un problème

Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Avatar
François Picalausa
Bonjour/soir,

tu pourrais faire quelquechose comme ceci:
'Dans un usercontrol, UserControl1:
Private Declare Function BitBlt _
Lib "gdi32" _
( _
ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long _
) _
As Long

Public Sub CopyControlPicture(hDestDC As Long, x As Long, y As Long)
UserControl.ScaleMode = 3 'pixels
BitBlt hDestDC, _
x, _
y, _
UserControl.ScaleWidth, _
UserControl.ScaleHeight, _
UserControl.hDC, _
0, _
0, _
vbSrcCopy
End Sub

'Dans une feuille comprenant
'un UserControl1, UserControl11
'et un PictureBox, Picture1

Private Sub Form_Click()
UserControl11.CopyControlPicture Picture1.hDC, 0, 0
End Sub

----------------------------------------------------------------------

Si tu préfère directement avoir un objet picture, c'est aussi possible.
Voici quelques lignes le permettant:

Option Explicit

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

Private Declare Function BitBlt _
Lib "gdi32" _
( _
ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long _
) _
As Long

Private Declare Function CreateCompatibleDC _
Lib "gdi32" _
( _
ByVal hdc As Long _
) _
As Long

Private Declare Function CreateCompatibleBitmap _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long _
) _
As Long
Private Declare Function SelectObject _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetDeviceCaps _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal nIndex As Long _
) _
As Long

Private Declare Function DeleteDC _
Lib "gdi32" _
( _
ByVal hdc As Long _
) _
As Long
Private Declare Function ReleaseDC _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal hdc As Long _
) _
As Long

Private Declare Function OleCreatePictureIndirect _
Lib "olepro32.dll" _
( _
pPictDesc As PicBmp, _
riid As GUID, _
ByVal fOwn As Long, _
ppvObj As IPicture _
) _
As Long

Public Function GetPicture() As Picture
UserControl.ScaleMode = 3 'on travaille en pixels

Dim hmemDC As Long
Dim hBmp As Long
Dim hBmpPrev As Long

'Crée un DC pour la copie
hmemDC = CreateCompatibleDC(UserControl.hdc)

'crée un bitmap et le sélectionne dans le dc
hBmp = CreateCompatibleBitmap _
( _
UserControl.hdc, _
UserControl.ScaleWidth, _
UserControl.ScaleHeight _
)

hBmpPrev = SelectObject(hmemDC, hBmp)

'Copie l'image
BitBlt hmemDC, _
0, 0, UserControl.ScaleWidth, _
UserControl.ScaleHeight, _
UserControl.hdc, _
0, _
0, _
vbSrcCopy

'Restaure le DC (bitmap et palette)
hBmp = SelectObject(hmemDC, hBmpPrev)

'Rend les ressources au système
DeleteDC hmemDC
ReleaseDC UserControl.hwnd, UserControl.hdc

'converti le bitmap en objet OLE picture

Dim Pic As PicBmp

Dim IPic As IPicture
Dim IID_IDispatch As GUID

With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
End With

OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic

Set GetPicture = IPic
End Function

--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com


"Sébastien Côté" a écrit dans le message
de news:S3Wmb.852$
Sous VB 6...

Comment sauvegarder l'image d'un contrôle personnalisé i.e. à dire que
j'aimerais ajouter a mon User control, qui contient des textbox,
labels, etc. une fonction du type SavePicture.

Merci à l'avance!

Seb


Avatar
Sébastien Côté
Merci beaucoup, c'est éxactement ca que je cherchais!!

Seb

"François Picalausa" a écrit dans le message de
news:%
Bonjour/soir,

tu pourrais faire quelquechose comme ceci:
'Dans un usercontrol, UserControl1:
Private Declare Function BitBlt _
Lib "gdi32" _
( _
ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long _
) _
As Long

Public Sub CopyControlPicture(hDestDC As Long, x As Long, y As Long)
UserControl.ScaleMode = 3 'pixels
BitBlt hDestDC, _
x, _
y, _
UserControl.ScaleWidth, _
UserControl.ScaleHeight, _
UserControl.hDC, _
0, _
0, _
vbSrcCopy
End Sub

'Dans une feuille comprenant
'un UserControl1, UserControl11
'et un PictureBox, Picture1

Private Sub Form_Click()
UserControl11.CopyControlPicture Picture1.hDC, 0, 0
End Sub

----------------------------------------------------------------------

Si tu préfère directement avoir un objet picture, c'est aussi possible.
Voici quelques lignes le permettant:

Option Explicit

Private Type GUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type

Private Type PicBmp
Size As Long
Type As Long
hBmp As Long
hPal As Long
Reserved As Long
End Type

Private Declare Function BitBlt _
Lib "gdi32" _
( _
ByVal hDestDC As Long, _
ByVal x As Long, _
ByVal y As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long, _
ByVal hSrcDC As Long, _
ByVal xSrc As Long, _
ByVal ySrc As Long, _
ByVal dwRop As Long _
) _
As Long

Private Declare Function CreateCompatibleDC _
Lib "gdi32" _
( _
ByVal hdc As Long _
) _
As Long

Private Declare Function CreateCompatibleBitmap _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal nWidth As Long, _
ByVal nHeight As Long _
) _
As Long
Private Declare Function SelectObject _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal hObject As Long _
) _
As Long
Private Declare Function GetDeviceCaps _
Lib "gdi32" _
( _
ByVal hdc As Long, _
ByVal nIndex As Long _
) _
As Long

Private Declare Function DeleteDC _
Lib "gdi32" _
( _
ByVal hdc As Long _
) _
As Long
Private Declare Function ReleaseDC _
Lib "user32" _
( _
ByVal hwnd As Long, _
ByVal hdc As Long _
) _
As Long

Private Declare Function OleCreatePictureIndirect _
Lib "olepro32.dll" _
( _
pPictDesc As PicBmp, _
riid As GUID, _
ByVal fOwn As Long, _
ppvObj As IPicture _
) _
As Long

Public Function GetPicture() As Picture
UserControl.ScaleMode = 3 'on travaille en pixels

Dim hmemDC As Long
Dim hBmp As Long
Dim hBmpPrev As Long

'Crée un DC pour la copie
hmemDC = CreateCompatibleDC(UserControl.hdc)

'crée un bitmap et le sélectionne dans le dc
hBmp = CreateCompatibleBitmap _
( _
UserControl.hdc, _
UserControl.ScaleWidth, _
UserControl.ScaleHeight _
)

hBmpPrev = SelectObject(hmemDC, hBmp)

'Copie l'image
BitBlt hmemDC, _
0, 0, UserControl.ScaleWidth, _
UserControl.ScaleHeight, _
UserControl.hdc, _
0, _
0, _
vbSrcCopy

'Restaure le DC (bitmap et palette)
hBmp = SelectObject(hmemDC, hBmpPrev)

'Rend les ressources au système
DeleteDC hmemDC
ReleaseDC UserControl.hwnd, UserControl.hdc

'converti le bitmap en objet OLE picture

Dim Pic As PicBmp

Dim IPic As IPicture
Dim IID_IDispatch As GUID

With IID_IDispatch
.Data1 = &H20400
.Data4(0) = &HC0
.Data4(7) = &H46
End With

With Pic
.Size = Len(Pic)
.Type = vbPicTypeBitmap
.hBmp = hBmp
End With

OleCreatePictureIndirect Pic, IID_IDispatch, 1, IPic

Set GetPicture = IPic
End Function

--
François Picalausa (MVP VB)
FAQ VB : http://faq.vb.free.fr
MSDN : http://msdn.microsoft.com


"Sébastien Côté" a écrit dans le message
de news:S3Wmb.852$
> Sous VB 6...
>
> Comment sauvegarder l'image d'un contrôle personnalisé i.e. à dire que
> j'aimerais ajouter a mon User control, qui contient des textbox,
> labels, etc. une fonction du type SavePicture.
>
> Merci à l'avance!
>
> Seb