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
| Option Explicit
'pour lire la couleur d'un pixel
Private Declare Function GetPixel Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long) As Long
' pour colorer une surface avec un pinceau image ou une couleur
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 ExtFloodFill Lib "gdi32" ( _
ByVal hdc As Long, _
ByVal X As Long, _
ByVal Y As Long, _
ByVal crColor As Long, _
ByVal wFillType As Long) As Long
Private Const FLOODFILLBORDER = 0
Private Const FLOODFILLSURFACE = 1
Private Sub Form_Load()
Me.ScaleMode = 3
Me.AutoRedraw = True
Label1.Top = 6: Label1.Left = 6
Label1 = "Maj. plus Click peinture de la couleur dans picture1"
Label2.Top = 26: Label2.Left = 6
Label2 = "Ctrl. plus Click peinture de l'image dans picture1"
Picture1.ScaleMode = 3
Picture1.Top = 44: Picture1.Left = 6
Picture1.Height = 149: Picture1.Width = 149
Picture1.AutoRedraw = True
Picture2.BackColor = &HFFFF&
Me.Height = 3420: Me.Width = 4110
Dim A, B As Integer
A = 27: B = 7
'dessin d'un pseudo losange dans Picture1
Picture1.Line (A, A * 2)-(A * 3, B / 4), 255
Picture1.Line -(A * 5, B * 8), 255
Picture1.Line -(A * 3, B * 16), 255
Picture1.Line -(A, A * 2), 255
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Shift = 1 Or Shift = 2 Then Else Exit Sub
'pour remplir le losange
Dim mBrush As Long
Dim FB As String
Dim objPic As Picture
If Shift = 2 Then 'Ctrl
FB = "C:\PersoFrancis\GrdPersonage2Zoom.bmp" '******* adapter ************
Set objPic = LoadPicture(FB) 'Chargement du bitmap
mBrush = CreatePatternBrush(objPic) 'Création de la brosse
SelectObject Picture1.hdc, mBrush 'Activation de la brosse
'Peinture dans la zone x,y dans l'image "Picture1", avec le pinceau image "FB"
ExtFloodFill Picture1.hdc, X, Y, GetPixel(Picture1.hdc, X, Y), FLOODFILLSURFACE
DeleteObject mBrush 'Nettoyage de la brosse
End If
If Shift = 1 Then 'Maj.
'Peinture dans la zone x,y de la couleur Picture2.BackColor
Set objPic = Picture2.Image 'Chargement de l'objet model
mBrush = CreatePatternBrush(objPic)
SelectObject Picture1.hdc, mBrush
ExtFloodFill Picture1.hdc, X, Y, GetPixel(Picture1.hdc, X, Y), FLOODFILLSURFACE
DeleteObject mBrush
End If
Picture1.Refresh
End Sub |
Partager