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
| Option Explicit
Public Const DI_MASK = &H1
Public Const DI_IMAGE = &H2
Public Const DI_NORMAL = DI_MASK Or DI_IMAGE
Public Declare Function ExtractIconEx Lib "shell32.dll" Alias "ExtractIconExA" (ByVal lpszFile As String, ByVal nIconIndex As Long, phiconLarge As Long, phiconSmall As Long, ByVal nIcons As Long) As Long
Public Declare Function DrawIcon Lib "user32" (ByVal hdc As Long, ByVal X As Long, ByVal Y As Long, ByVal hIcon As Long) As Long
Public Declare Function ExtractAssociatedIcon Lib "shell32.dll" Alias "ExtractAssociatedIconA" (ByVal hInst As Long, ByVal lpIconPath As String, lpiIcon As Long) As Long
Public Declare Function DrawIconEx Lib "user32" (ByVal hdc As Long, ByVal xLeft As Long, ByVal yTop As Long, ByVal hIcon As Long, ByVal cxWidth As Long, ByVal cyWidth As Long, ByVal istepIfAniCur As Long, ByVal hbrFlickerFreeDraw As Long, ByVal diFlags As Long) As Long
Public Declare Function DestroyIcon Lib "user32" (ByVal hIcon As Long) As Long
Public Declare Function CreateRectRgn Lib "gdi32" (ByVal x1 As Long, ByVal y1 As Long, ByVal X2 As Long, ByVal Y2 As Long) As Long
Public Declare Function CombineRgn Lib "gdi32" (ByVal hDestRgn As Long, ByVal hSrcRgn1 As Long, ByVal hSrcRgn2 As Long, ByVal nCombineMode As Long) As Long
Public Declare Function SetWindowRgn Lib "user32" (ByVal hWnd As Long, ByVal hRgn As Long, ByVal bRedraw As Long) As Long
Public Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Declare Function GetDIBits Lib "gdi32" (ByVal aHDC As Long, ByVal hBitmap As Long, ByVal nStartScan As Long, ByVal nNumScans As Long, lpBits As Any, lpBI As BITMAPINFO, ByVal wUsage As Long) As Long
Public Type BITMAP
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public Type BITMAPINFOHEADER
biSize As Long
biWidth As Long
biHeight As Long
biPlanes As Integer
biBitCount As Integer
biCompression As Long
biSizeImage As Long
biXPelsPerMeter As Long
biYPelsPerMeter As Long
biClrUsed As Long
biClrImportant As Long
End Type
Public Type RGBQUAD
rgbBlue As Byte
rgbGreen As Byte
rgbRed As Byte
rgbReserved As Byte
End Type
Public Type BITMAPINFO
bmiHeader As BITMAPINFOHEADER
bmiColors As RGBQUAD
End Type
Public Const DIB_RGB_COLORS = 0&
Public Const BI_RGB = 0&
Public Const pixR As Integer = 3
Public Const pixG As Integer = 2
Public Const pixB As Integer = 1
Public Sub bricolage(ByVal coucou As PictureBox, ByVal zombie As Long)
Dim bitmap_info As BITMAPINFO
Dim NBP() As Byte, NBBL As Integer, NBPL As Integer
Dim rouge As Byte, vert As Byte, bleu As Byte, large As Integer, haut As Integer
Dim X As Integer, Y As Integer, dx As Integer, fx As Integer, region0 As Long, region1 As Long
With bitmap_info.bmiHeader
.biSize = 40
.biWidth = coucou.ScaleWidth
.biHeight = -coucou.ScaleHeight
.biPlanes = 1
.biBitCount = 32
.biCompression = BI_RGB
NBBL = ((((.biWidth * .biBitCount) + 31) \ 32) * 4)
NBPL = NBBL - (((.biWidth * .biBitCount) + 7) \ 8)
.biSizeImage = NBBL * Abs(.biHeight)
End With
large = coucou.ScaleWidth
haut = coucou.ScaleHeight
ReDim NBP(1 To 4, 0 To large - 1, 0 To haut - 1)
GetDIBits coucou.hdc, coucou.Image, 0, coucou.ScaleHeight, NBP(1, 0, 0), bitmap_info, DIB_RGB_COLORS
cherchecoul zombie, rouge, vert, bleu
For Y = 0 To haut - 1
X = 1
Do While X < large
dx = 0: fx = 0
Do While X < large
If NBP(pixR, X, Y) <> rouge Or NBP(pixG, X, Y) <> vert Or NBP(pixB, X, Y) <> bleu Then Exit Do
X = X + 1
Loop
dx = X
Do While X < large
If NBP(pixR, X, Y) = rouge And NBP(pixG, X, Y) = vert And NBP(pixB, X, Y) = bleu Then Exit Do
X = X + 1
Loop
fx = X
If dx < large Then
If fx >= large Then fx = large - 1
region1 = CreateRectRgn(dx + 0, Y + 0, fx + 0, Y + 1)
If region0 = 0 Then
region0 = region1
Else
CombineRgn region0, region0, region1, 2
DeleteObject region1
End If
End If
Loop
Next Y
SetWindowRgn coucou.hWnd, region0, True
DeleteObject region0
End Sub
Private Sub cherchecoul(ByRef color As Long, ByRef r As Byte, ByRef g As Byte, ByRef b As Byte)
r = color And &HFF&
g = (color And &HFF00&) \ &H100&
b = (color And &HFF0000) \ &H10000
End Sub |
Conteneur transparent sur lequel on peut dessiner (hDC)
Répondre avec citation
Envoyé par windob
).
... fastoche, hein (s'il a su s'expliquer...)
Partager