'--- Code in BmpModule ---
Private Type BitMap
bmType As Long
bmWidth As Long
bmHeight As Long
bmWidthBytes As Long
bmPlanes As Integer
bmBitsPixel As Integer
bmBits As Long
End Type
Public StartPosX As Single
Public StartPosY As Single
Public EndPosX As Single
Public EndPosY As Single
Private Declare Function GetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function SetBitmapBits Lib "gdi32" (ByVal hBitmap As Long, ByVal dwCount As Long, lpBits As Any) As Long
Private Declare Function GetObject Lib "gdi32" Alias "GetObjectA" (ByVal hObject As Long, ByVal nCount As Long, lpObject As Any) As Long
Private Declare Function DeleteObject Lib "gdi32" (ByVal hObject As Long) As Long
Public Sub GetPart(Picture1 As PictureBox, Picture2 As PictureBox)
Dim bmWidth As Long
Dim bmHeight As Long
Dim bmSize As Long
Dim NewbmSize As Long
Dim bmBits() As Byte
Dim bmZoomWidth As Long
Dim bmZoomHeight As Long
'Get picture's Width and Height
bmWidth = Picture1.Width
bmHeight = Picture1.Height
bmZoomWidth = EndPosX - StartPosX
bmZoomHeight = EndPosY - StartPosY
'ReDefine Bit array to hold all pixels from picture box
ReDim Bits(0 To bmWidth - 1, 0 To bmHeight - 1) As Byte
'ReDim BitsZoom(0 To bmZoomWidth - 1, 0 To bmZoomHeight - 1) As Byte
ReDim BitsZoom(StartPosX To EndPosX - 1, StartPosY To EndPosY - 1) As Byte
'Store size of bitmap in total pixels
bmSize = bmWidth * bmHeight
'Grab picture's pixels and load to Bit array
GetBitmapBits Picture1.Image, bmSize, Bits(0, 0)
'Get Bits Selected
Dim Y As Long
Dim X As Long
For Y = StartPosY To EndPosY - 1
For X = StartPosX To EndPosX - 1
BitsZoom(X - StartPosX, Y - StartPosY) = Bits(X, Y)
Next X
Next Y
'Load Bit array to picture box
Picture2.Width = bmZoomWidth
Picture2.Height = bmZoomHeight
NewbmSize = bmZoomWidth * bmZoomHeight
SetBitmapBits Picture2.Image, NewbmSize, BitsZoom(0, 0)
'Redraw
Picture2.Refresh
End Sub
'--- Form's Code ---
Private Sub Picture1_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
StartPosX = X
StartPosY = Y
'The Shape thing is to provide a sensation of selection
With Shape1
.Left = X
.Top = Y
.Width = 0
.Height = 0
.BorderStyle = 5
.Visible = True
.Tag = ""
End With
End Sub
Private Sub Picture1_MouseMove(Button As Integer, Shift As Integer, X As Single, Y As Single)
With Shape1
If Shape1.Visible = True And .Tag = "" Then
.Width = Abs(StartPosX - X)
.Height = Abs(StartPosY - Y)
End If
End With
End Sub
Private Sub Picture1_MouseUp(Button As Integer, Shift As Integer, X As Single, Y As Single)
EndPosX = X
EndPosY = Y
Shape1.Tag = "Selected"
End Sub
Private Sub CmdCopyAll_Click()
StartPosY = 0
EndPosY = Picture1.Height
StartPosX = 0
EndPosX = Picture1.Width
GetPart Picture1, Picture2
End Sub
Private Sub CmdGetPart_Click()
If Shape1.Visible = False Then
StartPosY = 0
EndPosY = Picture1.Height
StartPosX = 0
EndPosX = Picture1.Width
Else
Shape1.Visible = False
End If
Me.MousePointer = vbHourglass
GetPart Picture1, Picture2
Me.MousePointer = vbDefault
End Sub