Put 2 PictureBoxes on your form. Make sure they both have these properties:
Appearance = Flat
AutoRedraw = True
Border Style = None
Picture = a picture that is small enough to fit in a picture box that is relatively small (320x240 is good for this demo)
ScaleMode = Pixel
Set these properties on your form:
ScaleMode = Pixel
Put a command button on your form.
Put all this code in your form:
Create a class, and call it ImgObj. Then put this code in that class:
Appearance = Flat
AutoRedraw = True
Border Style = None
Picture = a picture that is small enough to fit in a picture box that is relatively small (320x240 is good for this demo)
ScaleMode = Pixel
Set these properties on your form:
ScaleMode = Pixel
Put a command button on your form.
Put all this code in your form:
Code:
Dim a As ImgObj
Dim StartX As Long
Dim StartY As Long
Private Sub Command1_Click()
Set a = Nothing
End Sub
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
If (a Is Nothing) = False Then Exit Sub
Set a = New ImgObj
StartX = X
StartY = Y
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
Dim X0 As Long
Dim X1 As Long
Dim Y0 As Long
Dim Y1 As Long
If Button <> 1 Then Exit Sub
If a Is Nothing Then Exit Sub
If a.ImageInited Then Exit Sub
If X > StartX Then
X0 = StartX
X1 = X
Else
X0 = X
X1 = StartX
End If
If Y > StartY Then
Y0 = StartY
Y1 = Y
Else
Y0 = Y
Y1 = StartY
End If
If a.InitImage(X1 - X0 + 1, Y1 - Y0 + 1) = False Then
Set a = Nothing
Exit Sub
End If
a.BltFromDC Picture1.hDC, X0, Y0
End Sub
Private Sub Picture2_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button <> 1 Then Exit Sub
If a Is Nothing Then Exit Sub
If a.ImageInited = False Then Exit Sub
a.BltToDC Picture2.hDC, X, Y
Picture2.Refresh
End SubCreate a class, and call it ImgObj. Then put this code in that class:
Code:
Private Declare Function GetDC Lib "user32.dll" (ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32.dll" (ByVal hwnd As Long, ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function DeleteDC Lib "gdi32.dll" (ByVal hDC As Long) As Long
Private Declare Function CreateCompatibleBitmap Lib "gdi32.dll" (ByVal hDC As Long, ByVal nWidth As Long, ByVal nHeight As Long) As Long
Private Declare Function SelectObject Lib "gdi32.dll" (ByVal hDC As Long, ByVal hObject As Long) As Long
Private Declare Function DeleteObject Lib "gdi32.dll" (ByVal hObject As Long) As Long
Private Declare Function BitBlt Lib "gdi32.dll" (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
Dim ImageHandle As Long
Dim DCHandle As Long
Dim OldImageHandle As Long
Dim ImgInited As Boolean
Dim PicW As Long
Dim PicH As Long
Public Event GetImageParams(ByRef Width As Long, ByRef Height As Long)
Public Property Get hImage()
hImage = ImageHandle
End Property
Public Property Get hDC()
hDC = DCHandle
End Property
Public Property Get Width()
Width = PicW
End Property
Public Property Get Height()
Height = PicH
End Property
Public Property Get ImageInited() As Boolean
ImageInited = ImgInited
End Property
Private Sub Class_Initialize()
Dim tempDC As Long
tempDC = GetDC(0)
DCHandle = CreateCompatibleDC(tempDC)
ReleaseDC 0, tempDC
End Sub
Public Function InitImage(ByVal Width As Long, ByVal Height As Long) As Boolean
Dim tempDC As Long
If (PicW > 0) Or (PicH > 0) Then Exit Function
If Width <= 0 Then Exit Function
If Height <= 0 Then Exit Function
PicW = Width
PicH = Height
tempDC = GetDC(0)
ImageHandle = CreateCompatibleBitmap(tempDC, PicW, PicH)
ReleaseDC 0, tempDC
OldImageHandle = SelectObject(DCHandle, ImageHandle)
InitImage = True
ImgInited = True
End Function
Private Sub Class_Terminate()
SelectObject DCHandle, OldImageHandle
DeleteObject ImageHandle
DeleteObject OldImageHandle
DeleteDC DCHandle
End Sub
Public Sub BltToDC(ByVal DestDC As Long, Optional ByVal X As Long, Optional ByVal Y As Long)
BitBlt DestDC, X, Y, PicW, PicH, DCHandle, 0, 0, vbSrcCopy
End Sub
Public Sub BltFromDC(ByVal SrcDC As Long, Optional ByVal X As Long, Optional ByVal Y As Long)
BitBlt DCHandle, 0, 0, PicW, PicH, SrcDC, X, Y, vbSrcCopy
End Sub