CodeItBetter Programming Another VB Programming Blog

How to select portion of Picture and paste it to Picture Box

Posted on January 5, 2009
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
'Graphics - How to select portion of Picture and paste it to Picture Box

Option Explicit
 
'Draw with the mouse rectangle on the picture, and press the button. The area of the
'picture that found inside the rectangle will be pasted to the second picture box.

'Add a Command Button and two Picture Boxes to your form and add a picture to Picture Box control.
'Set Picture1 and Picture2 ScaleMode property to 3 - Pixel.

Declare Function BitBlt Lib "gdi32" (ByVal hDestDC 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 dwRop As Long) As Long
Public Const SRCCOPY = &HCC0020
 
Dim minX As Single, maxX As Single, minY As Single, maxY As Single
Dim isRectExist As Boolean
 
Private Sub Command1_Click()
    Picture2.Cls
    If maxX < minX Then
        temp = minX
        minX = maxX
        maxX = temp
    End If
    If maxY < minY Then
        temp = minY
        minY = maxY
        maxY = temp
    End If
    Result& = BitBlt(Picture2.hdc, 0, 0, maxX - minX, maxY - minY, Picture1.hdc, minX, minY, SRCCOPY)
End Sub
 
Sub Form_Load()
    isBoxExist = False
    minX = -10
    maxX = 10
    minY = -10
    maxY = 10
End Sub
 
Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        If isRectExist Then
            Picture1.Cls
            isBoxExist = False
        End If
        minX = X
        maxY = Y
        maxX = X
        maxY = Y
    End If
End Sub
 
Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
    If Button = 1 Then
        Picture1.DrawMode = 10
        Picture1.Line (minX, maxY)-(maxX, minY), , B
        maxX = X
        minY = Y
        Picture1.Line (minX, maxY)-(maxX, minY), , B
        Picture1.DrawMode = 13
    End If
End Sub
 
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
    isRectExist = True
End Sub
Filed under: Graphics Leave a comment
Comments (0) Trackbacks (0)

No comments yet.


Leave a comment


 

No trackbacks yet.