BITMAP ET BRUSHES

Signaler
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
-
Messages postés
488
Date d'inscription
lundi 15 septembre 2003
Statut
Membre
Dernière intervention
21 avril 2009
-
Cette discussion concerne un article du site. Pour la consulter dans son contexte d'origine, cliquez sur le lien ci-dessous.

https://codes-sources.commentcamarche.net/source/17764-bitmap-et-brushes

Messages postés
488
Date d'inscription
lundi 15 septembre 2003
Statut
Membre
Dernière intervention
21 avril 2009

Merci Renfield, t un killer comme d'hab ; ))
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
66
j'ai posté un pseudo portage de ta source :

http://www.vbfrance.com/code.aspx?ID=17777


j'espere que ca te conviendra....
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
66
'#A Placer dans un module.... (facultatif !)

Private Declare Function CreatePatternBrush Lib "gdi32" (ByVal hBitmap As Long) As Long
Private Declare Function SelectObject Lib "gdi32" (ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Private Declare Function TextOut Lib "gdi32" Alias "TextOutA" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal lpString As String, ByVal nCount As Long) As Long
Private Declare Function PatBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal dwRop As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" Alias "GetTextExtentPoint32A" (ByVal hdc As Long, ByVal lpsz As String, ByVal cbString As Long, lpSize As SIZE) As Long

Private Type SIZE
cw As Long
ch As Long
End Type

Private Const PATINVERT = &H5A0049

Public Function DCTextWidth(hdc As Long, Str As String) As Long
Dim SIZE As SIZE
GetTextExtentPoint32 hdc, Str, Len(Str), SIZE
DCTextWidth = SIZE.cw
End Function

Public Function DCTextHeight(hdc As Long, Str As String) As Long
Dim SIZE As SIZE
GetTextExtentPoint32 hdc, Str, Len(Str), SIZE
DCTextHeight = SIZE.ch
End Function

Public Function DrawBrushedText(ByVal hdc As Long, ByVal X As Single, ByVal Y As Single, ByVal Str As String, ByVal hBrush As Long) As Boolean
Dim oldBrush As Long
oldBrush = SelectObject(hdc, hBrush)

Dim Width As Long: Width = DCTextWidth(hdc, Str)
Dim Height As Long: Height = DCTextHeight(hdc, Str)

PatBlt hdc, X, Y, Width, Height, PATINVERT
TextOut hdc, X, Y, Str, Len(Str)
DrawBrushedText = PatBlt(hdc, X, Y, Width, Height, PATINVERT)

SelectObject hdc, oldBrush
End Function


'# A Placer dans une Form possedant une pictureBox "Picture1", avec une image !!!
Private Sub Form_Load()
Dim hBrush As Long
hBrush = CreatePatternBrush(Picture1.Image)

Me.FontName = "Arial"
Me.FontSize = 72
Me.AutoRedraw = True
Me.Width = 8500
Me.Height = 3000

DrawBrushedText Me.hdc, 30, 30, "By Renfield", hBrush
DeleteObject hBrush
End Sub
Messages postés
17286
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
23 décembre 2019
66
C'est une solution aussi..... je ne comptait pas faire comme ca.....
Afficher les 9 commentaires