|
Select Portion Of Picture And Paste It To Picture Box
Select Portion Of Picture And Paste It To Picture Box
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.
Preparations
Add 1 Command Button and 2 Picture Boxes to your form.
Add picture to Picture1 Picture Box.
Set Picture1 and Picture2 ScaleMode property to 3 - Pixel.
Module Code
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
Form Code
Dim minX As Single
Dim maxX As Single
Dim minY As Single
Dim maxY As Single
Dim isRectExist As Boolean
Private Sub Command1_Click()
'clear Picture2
Picture2.Cls
'assure that maxX will hold the maxium X value and minX the minimum X
value.
If maxX < minX Then
temp = minX
minX = maxX
maxX = temp
End If
'assure that maxY will hold the maxium Y value and minY the minimum Y
value.
If maxY < minY Then
temp = minY
minY = maxY
maxY = temp
End If
'will draw the rectangle area to Picture2. It will start drawing it from
Picture2
'upper left corner. If you want to change the place of drawing, replace
the
' "0,0" below with the starting point
Result& = BitBlt(Picture2.hDC, 0, 0, maxX - minX, maxY - minY,
Picture1.hDC, _
minX, minY, SRCCOPY)
End Sub
Sub Form_Load()
isBoxExist = False
'initialize the rectangle
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 a rectangle is already drawn, delete it
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)
'Drawing the rectangle
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)
'update the isRectExist variable, so the next time the user will start
drawing the rectangle,
'we will know that a rectangle is already exist, and we will delete the
old rectangle
isRectExist = True
End Sub
| |