Ce projet nécessite:
- 2 picture boxes
- 1 buttonPrivate Type POINTAPI
X As Long
Y As Long
End Type
Private Declare Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As
Long, ByVal Y As Long) As Long
Private Declare Function SetPixel Lib "gdi32" (ByVal hdc As Long, ByVal X As
Long, ByVal Y As Long, ByVal crColor As Long) As Long
Private Declare Function PaintDesktop Lib "user32" (ByVal hdc As Long) As Long
Private Declare Function StretchBlt Lib "gdi32" (ByVal hdc As Long, ByVal X As
Long, ByVal Y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hSrcDC As Long,
ByVal xSrc As Long, ByVal ySrc As Long, ByVal nSrcWidth As Long, ByVal nSrcHeight As Long,
ByVal dwRop As Long) As Long
Private Declare Function GetBkColor Lib "gdi32" (ByVal hdc As Long) As Long
Private Declare Function MoveToEx Lib "gdi32" (ByVal hdc As Long, ByVal X As
Long, ByVal Y As Long, lpPoint As POINTAPI) As Long
Private Declare Function LineTo Lib "gdi32" (ByVal hdc As Long, ByVal X As Long,
ByVal Y As Long) As Long
Const ScrCopy = &HCC0020
Const Yellow = &HFFFF&
Private Sub Form_Load()
'VbAndJava 1999/2000
'Guerrault Yonni
'E-Mail : Yonni4@iFrance.com
Dim Cnt1 As Byte, Cnt2 As Byte, Point As POINTAPI
Me.AutoRedraw = True
Me.ScaleMode = vbPixels
Picture1.ScaleMode = vbPixels
Picture2.ScaleMode = vbPixels
Picture1.BorderStyle = 0: Picture2.BorderStyle = 0
Command1.Caption = "Paint && Stretch"
Picture1.AutoRedraw = False: Picture2.AutoRedraw = False
For Cnt1 = 0 To 100 Step 3
For Cnt2 = 0 To 100 Step 3
Point.X = Cnt1: Point.Y = Cnt2
MoveToEx Me.hdc, Cnt1, Cnt2, Point
LineTo Me.hdc, 200, 200
Next Cnt2
Next Cnt1
For Cnt1 = 0 To 100 Step 5
For Cnt2 = 0 To 100 Step 5
SetPixel Me.hdc, Cnt1, Cnt2, Yellow
Next Cnt2
Next Cnt1
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As
Single)
Dim XX As Long, YY As Long, A As Long
XX = X: YY = Y
Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As
Single)
If Button = 1 Then
Dim XX As Long, YY As Long, A As Long
XX = X: YY = Y
Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
End If
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As
Single)
Dim XX As Long, YY As Long, A As Long
XX = X: YY = Y
Picture2.BackColor = GetPixel(Picture1.hdc, XX, YY)
End Sub
Private Sub Command1_Click()
Picture2.Width = 100: Picture2.Height = 100
Picture1.Width = 50: Picture1.Height = 50
Picture1.Picture = LoadPicture("")
DoEvents
PaintDesktop Picture1.hdc
StretchBlt Picture2.hdc, 0, 0, 100, 100, Picture1.hdc, 0, 0, 50, 50, ScrCopy
End Sub |