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 |