Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 8 nov. 2003 à 00:52
'#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)
DrawBrushedText Me.hdc, 30, 30, "By Renfield", hBrush
DeleteObject hBrush
End Sub
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 7 nov. 2003 à 17:38
C'est une solution aussi..... je ne comptait pas faire comme ca.....
cs_EBArtSoft
Messages postés4525Date d'inscriptiondimanche 29 septembre 2002StatutModérateurDernière intervention22 avril 20199 7 nov. 2003 à 16:58
FORMIDABLE... lol
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 !)
@+
cs_radada
Messages postés488Date d'inscriptionlundi 15 septembre 2003StatutMembreDernière intervention21 avril 20091 7 nov. 2003 à 15:25
ouais, je veux bien que tu m'envoie cette source en VB 6 un de ces 4 quand tu aura le temps!!!! Décidemment, je crois qu'il faut que j'aille hiberner loooooooool :D:D:D. Merci encore Renfield ; )
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 7 nov. 2003 à 15:03
en tout cas, c'est sympa, et très commenté.....
as réaliser en VB6, c'est possible, mais plus long, je te le ferai, si tu veux ;-)
cs_radada
Messages postés488Date d'inscriptionlundi 15 septembre 2003StatutMembreDernière intervention21 avril 20091 7 nov. 2003 à 14:32
ah merde!!!! lol, merci Renfield ; ))
Renfield
Messages postés17287Date d'inscriptionmercredi 2 janvier 2002StatutModérateurDernière intervention27 septembre 202174 7 nov. 2003 à 14:25
lol.
C'est tout a fait faisable en VB6 ausi, je te rassures....
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....