Texte transparent sur PictureBox

**Souleyre** · 04/01/2010, 16h28

Bonjour,
Je dessine un texte en caractères gras sur un PictureBox contenant un dessin (commandes utilisées: CurrentX, CurrentY & Print).
J'aimerais pouvoir rendre ce texte transparent pour laisser le dessin visible par en dessous.
Y aurait-il une solution simple?
Merci pour votre aide.

**ProgElecT** · 04/01/2010, 18h12

Tu as dût toucher à la propriété FontTransparent de ton Picture, mets là = True

Motif de l'edit:
A la lecture de ton message 1 plus bas,

desolé, j'ai lu trop vite, en diagonale

**Souleyre** · 04/01/2010, 21h00

La propriété FontTransparent ne commande que la transparence de la matrice des caractères. Au cas présent, il s'agit de définir la transparence du corps même des caractères.

**Delbeke** · 05/01/2010, 11h06

Ce que tu demandes est quelque chose impossible à vb6. Il faut passer par les apis de Windows.
Voici un module qui devrait te premettre toutes les fantaisies.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
Option Explicit
Private Const OPAQUE = 2
Private Const TRANSPARENT = 1
Private Const BS_HATCHED = 2
Private Const BS_NULL = 1
Private Const BS_SOLID = 0
Private Const HS_BDIAGONAL = 3
Private Const HS_CROSS = 4
Private Const HS_DIAGCROSS = 5
Private Const HS_FDIAGONAL = 2
Private Const HS_HORIZONTAL = 0
Private Const HS_VERTICAL = 1
Private Const PS_NULL = 5
Private Const PS_INSIDEFRAME = 6
Private Const PS_SOLID = 0
 
 
Private Type LOGFONT
        lfHeight As Long
        lfWidth As Long
        lfEscapement As Long
        lfOrientation As Long
        lfWeight As Long
        lfItalic As Byte
        lfUnderline As Byte
        lfStrikeOut As Byte
        lfCharSet As Byte
        lfOutPrecision As Byte
        lfClipPrecision As Byte
        lfQuality As Byte
        lfPitchAndFamily As Byte
        lfFaceName As String * 31
End Type
Private Type LOGBRUSH
        lbStyle As Long
        lbColor As Long
        lbHatch As Long
End Type
Private Type POINTAPI
        X As Long
        Y As Long
End Type
 
 
Private Declare Function CreateFontIndirect Lib "gdi32" Alias "CreateFontIndirectA" (lpLogFont As LOGFONT) 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 SetBkColor Lib "gdi32" (ByVal hDC As Long, ByVal crColor As Long) As Long
Private Declare Function SetBkMode Lib "gdi32" (ByVal hDC As Long, ByVal nBkMode As Long) As Long
Private Declare Function CreatePen Lib "gdi32" (ByVal nPenStyle As Long, ByVal nWidth As Long, ByVal crColor As Long) As Long
Private Declare Function CreateBrushIndirect Lib "gdi32" (lpLogBrush As LOGBRUSH) As Long
Private Declare Function BeginPath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function EndPath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function StrokePath Lib "gdi32" (ByVal hDC As Long) As Long
Private Declare Function StrokeAndFillPath Lib "gdi32" (ByVal hDC 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
 
 
Public Function PrintDetourTexte(X As Single, Y As Single, Text As String, _
                                FntTransparent As Boolean, _
                                BackColor As OLE_COLOR, _
                                ForeColor As OLE_COLOR, _
                                OutLineColor As OLE_COLOR, _
                                Pct As PictureBox) As Boolean
  Dim lRet As Long
  Dim Font As LOGFONT
  Dim Brush As LOGBRUSH
  Dim hPen As Long
  Dim hBrush As Long
  Dim hPrevFont As Long
  Dim hFont As Long
  Dim OldPen As Long
  Dim OldBrush As Long
  Dim Pt1 As POINTAPI
  Dim Pt2 As POINTAPI
  Dim strTemp As String
    Font.lfEscapement = 0 'angle du texte
    Font.lfOrientation = 0
    strTemp = Pct.FontName & Chr$(0)
    Font.lfFaceName = strTemp
    Font.lfHeight = Pct.FontSize * -20 / Screen.TwipsPerPixelX
    Font.lfItalic = Pct.FontItalic
    Font.lfUnderline = Pct.FontUnderline
    Font.lfStrikeOut = Pct.FontStrikethru
    If Pct.FontBold Then
      Font.lfWeight = 700
    Else
      Font.lfWeight = 400
    End If
    Font.lfCharSet = 1
    Font.lfClipPrecision = 0
    Font.lfOutPrecision = 0
    Font.lfPitchAndFamily = 0
    Font.lfQuality = 0
    hFont = CreateFontIndirect(Font)
    hPrevFont = SelectObject(Pct.hDC, hFont)
    strTemp = Text
      If FntTransparent = False Then
        'dessiner  le fond et le contour
        lRet = SetBkMode(Pct.hDC, OPAQUE)
        lRet = SetBkColor(Pct.hDC, BackColor)
        hPen = CreatePen(PS_SOLID, Pct.DrawWidth, OutLineColor)
        OldPen = SelectObject(Pct.hDC, hPen)
        SetBrush Brush, BackColor, BS_SOLID
        hBrush = CreateBrushIndirect(Brush)
        OldBrush = SelectObject(Pct.hDC, hBrush)
        lRet = BeginPath(Pct.hDC)
        PrintDetourTexte = TextOut(Pct.hDC, X, Y, strTemp, Len(strTemp))
        lRet = EndPath(Pct.hDC)
        lRet = StrokeAndFillPath(Pct.hDC)
        lRet = SelectObject(Pct.hDC, OldBrush)
        lRet = DeleteObject(hBrush)
        lRet = SelectObject(Pct.hDC, OldPen)
        lRet = DeleteObject(hPen)
'      Else
      End If
      'dessiner le contour et l'interieur des lettres
      lRet = SetBkColor(Pct.hDC, BackColor)
      lRet = SetBkMode(Pct.hDC, TRANSPARENT)
      hPen = CreatePen(PS_SOLID, Pct.DrawWidth, OutLineColor)
      OldPen = SelectObject(Pct.hDC, hPen)
      If ForeColor = vbWhite And _
         FntTransparent = True Then
        SetBrush Brush, ForeColor, BS_NULL
      Else
        SetBrush Brush, ForeColor, BS_SOLID
      End If
      hBrush = CreateBrushIndirect(Brush)
      OldBrush = SelectObject(Pct.hDC, hBrush)
      lRet = BeginPath(Pct.hDC)
      PrintDetourTexte = TextOut(Pct.hDC, X, Y, strTemp, Len(strTemp))
      lRet = EndPath(Pct.hDC)
      lRet = StrokeAndFillPath(Pct.hDC)
      lRet = SelectObject(Pct.hDC, OldBrush)
      lRet = DeleteObject(hBrush)
      lRet = SelectObject(Pct.hDC, OldPen)
      lRet = DeleteObject(hPen)
    lRet = SelectObject(Pct.hDC, hPrevFont)
    lRet = DeleteObject(hFont)
End Function
Private Sub SetBrush(LOGBRUSH As LOGBRUSH, FillColor As OLE_COLOR, FillStyle As Long)
  LOGBRUSH.lbColor = FillColor
  Select Case FillStyle
  Case 0
    LOGBRUSH.lbStyle = BS_SOLID
    LOGBRUSH.lbHatch = 0
  Case 1
    LOGBRUSH.lbStyle = BS_NULL
    LOGBRUSH.lbHatch = 0
  Case 2
    LOGBRUSH.lbStyle = BS_HATCHED
    LOGBRUSH.lbHatch = HS_HORIZONTAL
  Case 3
    LOGBRUSH.lbStyle = BS_HATCHED
    LOGBRUSH.lbHatch = HS_VERTICAL
  Case 4
    LOGBRUSH.lbStyle = BS_HATCHED
    LOGBRUSH.lbHatch = HS_BDIAGONAL
  Case 5
    LOGBRUSH.lbStyle = BS_HATCHED
    LOGBRUSH.lbHatch = HS_FDIAGONAL
  Case 6
    LOGBRUSH.lbStyle = BS_HATCHED
    LOGBRUSH.lbHatch = HS_CROSS
  Case 7
    LOGBRUSH.lbStyle = BS_HATCHED
    LOGBRUSH.lbHatch = HS_DIAGCROSS
  End Select
End Sub

Voici également un exemple d'utilisation de la fonction

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
Private Sub Command1_Click()
  Picture1.AutoRedraw = True
  Picture1.ScaleMode = vbPixels
  Picture1.FontName = "Times New Roman"
  Picture1.FontSize = 24
 
  PrintDetourTexte 10, 10, "Essai", False, vbGreen, vbYellow, vbBlue, Picture1
  PrintDetourTexte 10, 50, "Essai", True, vbGreen, vbYellow, vbBlue, Picture1
  PrintDetourTexte 10, 90, "Essai", True, vbGreen, vbWhite, vbBlue, Picture1
  Picture1.Refresh
End Sub

**Souleyre** · 05/01/2010, 12h28

Le résultat de ton programme est magnifique, Delbeke, et je vais sûrement l'utiliser; cependant il ne répond pas tout à fait à ce que je désirais. Je me suis sans doute mal exprimé: en fait j'aurais souhaité que la couleur même utilisée pour tracer les lettres soit transparente (alpha?); Est-ce possible à partir de ton module? En tout cas, merci pour ton aide.

**Delbeke** · 05/01/2010, 16h48

Alors là c'est encore plus compliqué et je ne vais pas me lancer dans une étude qui risque de prendre des jours
Une des pistes à suivre sont : Blend de 2 images, l'une contenant le fond, l'autre le texte. fonction api à étudier : AlphaBlend
Je ne suis même pas sûr qu'on puisse y arriver. Il te faudra probablement googler un peu.

Texte transparent sur PictureBox

VB 6 et antérieur

Vue hybride

Discussions similaires

Partager

Partager