BITMAP ET BRUSHES
Renfield
Messages postés
17287
Date d'inscription
mercredi 2 janvier 2002
Statut
Modérateur
Dernière intervention
27 septembre 2021
-
7 nov. 2003 à 14:25
cs_radada Messages postés 488 Date d'inscription lundi 15 septembre 2003 Statut Membre Dernière intervention 21 avril 2009 - 13 nov. 2003 à 17:12
cs_radada Messages postés 488 Date d'inscription lundi 15 septembre 2003 Statut Membre Dernière intervention 21 avril 2009 - 13 nov. 2003 à 17:12
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
https://codes-sources.commentcamarche.net/source/17764-bitmap-et-brushes
13 nov. 2003 à 17:12
8 nov. 2003 à 01:43
http://www.vbfrance.com/code.aspx?ID=17777
j'espere que ca te conviendra....
8 nov. 2003 à 00:52
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
7 nov. 2003 à 17:38
7 nov. 2003 à 16:58
niarf ;-P
Je pense tres cher Renfield que ça
donne qlq chose comme ce qui suit :
Private Sub Command1_Click()
Dim x&, y&, i&, j&, t$
Cls
t = "EBArtSoft@"
x = Picture1.Width
y = Picture1.Height
BeginPath Me.hdc
TextOut Me.hdc, 0, 0, t, Len(t)
EndPath Me.hdc
SelectClipPath Me.hdc, RGN_COPY
For i = 0 To Me.TextWidth(t) Step x
For j = 0 To Me.TextHeight(t) Step y
BitBlt Me.hdc, i * x, j * y, x, y, Picture1.hdc, 0, 0, vbSrcCopy
Next
Next
End Sub
Merci VB6 ... (de rien répond t-il !)
@+
7 nov. 2003 à 15:25
7 nov. 2003 à 15:03
as réaliser en VB6, c'est possible, mais plus long, je te le ferai, si tu veux ;-)
7 nov. 2003 à 14:32
7 nov. 2003 à 14:25
C'est tout a fait faisable en VB6 ausi, je te rassures....